Your Choice 3/Your Choice Software Collection 3.iso/prgmming/qb_tips/qbtips_t.doc

Text File | 1994-06-06 | 91KB | 3,003 lines

Name:             QBTips_T.Doc                         Date:  5/94

Also See:         QBTips_A through QBTips_R


Purpose:          To provide insights and source code to help BASIC
                  programmers -- beginner through advanced.

                  Load this into your word processor or editor.  Then
                  scan it for tidbits you think will be useful.  Just
                  "cut & paste" sections you like to separate files,
                  then run the code.


Source:           Below you'll find messages captured from the FidoNet
                  Quik_Bas echo.  We captured CODE and significant tips,
                  and eliminated chatter.


Format:           Varies, depending on the author, their programming
                  style, and the question or topic.

                  A form-feed (Chr$(12)) appears after most messages.
                  This allows you to print this, and have each message
                  (ie., each topic) start on a new page.


Recommendation:   None!

                  Some of what you'll see below is brilliant.  Some
                  demonstrates very poor programming techniques.  But
                  all of it can prove useful if you have a need.

                  NOTE 1:

                  We have NOT tried all the code you see here, and some
                  of it may not run as-is.  You may have to do a little
                  editing to coax it.  One reason that code may not run
                  is that messages sometimes get truncated or mangled in
                  transmission.  Another reason is that authors make
                  mistakes (or typos).  Again, we haven't tried running
                  everything; but when you do, you'll probably quickly
                  spot places that need editing.

                  NOTE 2:

                  There may be near-duplicate messages.  The original
                  author may have refined the code, or may have found
                  errors in the original.  If you see something that
                  looks interesting, before you rely on the code, scan
                  for the topic or author to see if a new set of code is
                  below you -- more recent messages appear below. And
                  note that the next message may be in a later package.

                  NOTE 3:

                  BEFORE running any code segment, scan through it and
                  LOOK FOR code fragments which could be DISASTROUS!

                  *** We often run un-tested code fragments from a  ***
                  *** RAM or floppy disk.  And BEFORE running it we ***
                  *** scan for "c:" or "d:" (or other hard drive)   ***
                  *** letters.  And we also scan for .. (see below) ***


                  For example, scan for "OUT " -- and if you find any
                  verify that the code is OUTting the correct values
                  to the correct ports.  Typos, transmission errors
                  or programmer mistakes could send the wrong values
                  to the wrong ports.  At best, nothing will happen.
                  At worst, you might fry your monitor -- or worse.

                  Also look for INTERRUPT (or INTERRUPTx).  These functions
                  are v-e-r-y useful for invoking low-level DOS or BIOS
                  functions.  But that low-level access also comes with
                  some risks!  Programmer or transmission errors, open
                  drive doors, etc., can, at best, cause your PC to hang.
                  At worst, you could corrupt the FAT of your hard disk.


=========================================================================


Msg #:  2135                      QUIKBAS Subboard
 From:  PETER MIKALAJUNAS         Sent: 11-22-93 21:16
   To:  MARVIN HART               Rcvd: -NO-
   Re:  ANSI FULL SCREEN EDIT 1/2

MH>No I'm not speaking about a program to design ansi screens. I'm
looking MH>for an (ansi based controlls) full screen editor so that I
can add it to MH>a bbs so users can have the option of wrtting,
replying to mail in MH>a line by line format or full screen. Sorry for
not explaining MH>what I'm looking for in better detail.

This should give you a push in the right direction.  Not sure who the
author is, had it laying around.  For full ansi support look at Pansi.

' TEXTWIN.BAS
' This Sample program shows how to use
' TextWindow -- a function that allows
' a user to enter a window of text
DEFINT A-Z
DECLARE FUNCTION TextWindow (Buffer$, Lines, Columns, x, y)
DECLARE SUB MakeBox (x, y, Lines, Columns)
CLS
LOCATE 15, 1: PRINT "Here are the results: "
'declare Text Window size
TextLines = 10: TextCols = 64
Xwindow = 3: Ywindow = 10
'declare buffer area to hold text
Buffer$ = SPACE$(TextLines * TextCols)
' call text window
ExitOK = TextWindow(Buffer$, TextLines, TextCols, Xwindow, Ywindow)
IF ExitOK THEN
 PRINT Buffer$
ELSE
 PRINT "Window not Saved"
END IF
END
SUB MakeBox (x, y, Lines, Columns)
' Draw a single line box beginning at X,Y
' box is Lines tall by Columns wide
DEFINT A-Z
' top row
LOCATE x, y, 0
PRINT CHR$(218);
PRINT STRING$(Columns - 2, CHR$(196));
PRINT CHR$(191)
'bottom row
LOCATE x + Lines - 1, y, 0
PRINT CHR$(192);
PRINT STRING$(Columns - 2, CHR$(196));
PRINT CHR$(217)
'sides
FOR I = 1 TO Lines - 2
   LOCATE x + I, y, 0: PRINT CHR$(179)
   LOCATE x + I, y + Columns - 1, 0
   PRINT CHR$(179)
NEXT I
END SUB
FUNCTION TextWindow (Buffer$, Lines, Columns, Xwindow, Ywindow)
' This function allows the user to key in a window
' of text the input area will be Lines by Columns
' in size.  xwindow and ywindow are the upper left
' corner coordinates of text entry window
' The text is placed in Buffer$
' returns TRUE if user saves with Ctrl-End,
' FALSE on Esc
'save cursor position
SaveX = CSRLIN: SaveY = POS(0)
' Scan codes for current valid user key-strokes
ScanKeyhome = 71
ScanKeyend = 79
ScanKeyup = 72
ScanKeyleft = 75
ScanKeyright = 77
ScanKeydown = 80
ScanKeyctrlleft = 115
ScanKeyctrlright = 116
ScanKeyinsert = 82
ScanKeydelete = 83
ScanKeyctrlend = 117
ScanKeyenter = 13
ScanKeyescape = 27
ScanKeybackspace = 8
'Start with insert mode turned off
FALSE = 0
TRUE = NOT FALSE
inserton = FALSE
' Draw box around text, display marquis
CALL MakeBox(Xwindow - 1, Ywindow - 1, Lines + 3, Columns + 2)
LOCATE Xwindow + Lines, Ywindow + 1, 0
PRINT "[Esc] to Abort,[Ctrl-End] to Save"
'Current X,Y Coordinates of cursor within window
XCoord = Xwindow: YCoord = Ywindow
'start taking text in top left corner
LOCATE XCoord, YCoord, 1
'main user input loop

DO
  UserKey$ = INKEY$
  SELECT CASE LEN(UserKey$)
    CASE 2 'two-byte scan codes
      SELECT CASE ASC(RIGHT$(UserKey$, 1))
        CASE ScanKeyhome
          XCoord = Xwindow: YCoord = Ywindow
        CASE ScanKeyend
          XCoord = Xwindow + Lines - 1
          YCoord = Ywindow + Columns - 1
        CASE ScanKeyup
          IF XCoord > Xwindow THEN
            XCoord = XCoord - 1
          END IF
        CASE ScanKeyleft
          IF YCoord > Ywindow THEN
            YCoord = YCoord - 1
          END IF
        CASE ScanKeyright
          IF YCoord < Ywindow + Columns - 1 THEN
            YCoord = YCoord + 1
          END IF
        CASE ScanKeydown
          IF XCoord < Xwindow + Lines - 1 THEN
            XCoord = XCoord + 1
          END IF
        CASE ScanKeyctrlleft
          GOSUB LeftWord
        CASE ScanKeyctrlright
          GOSUB RightWord
        CASE ScanKeyinsert
          inserton = NOT inserton
          LOCATE 25, 50, 0
          IF inserton THEN
            PRINT "Insert mode";
          ELSE
            PRINT SPACE$(11);
          END IF
        CASE ScanKeydelete
          GOSUB MoveLeft
        CASE ScanKeyctrlend
          TextWindow = TRUE
          EXIT DO
        CASE ELSE
          PRINT ASC(RIGHT$(UserKey$, 1))
      END SELECT
      LOCATE XCoord, YCoord, 1
    CASE 1 'single-character scan codes
      SELECT CASE ASC(UserKey$)
        CASE ScanKeyenter
          IF XCoord < Lines + Xwindow - 1 THEN
            XCoord = XCoord + 1
          END IF
          YCoord = Ywindow
          LOCATE XCoord, YCoord, 1
        CASE ScanKeyescape
          TextWindow = FALSE
          EXIT DO
        CASE ScanKeybackspace
          IF YCoord > Ywindow THEN
            YCoord = YCoord - 1
            GOSUB MoveLeft
          END IF
          LOCATE XCoord, YCoord, 1
        CASE ELSE
          IF inserton THEN
            GOSUB MoveRight
          END IF
          GOSUB UpdateBuffer
          LOCATE XCoord, YCoord, 1
          PRINT UserKey$;
          IF YCoord < Columns + Ywindow - 1 THEN
            YCoord = YCoord + 1
          END IF
      END SELECT
    END SELECT
LOOP
'End of main user input loop
'restore cursor position
LOCATE SaveX, SaveY, 1
EXIT FUNCTION
UpdateBuffer:
' put the character typed into the string buffer
   GOSUB ComputeBufPosn
   MID$(Buffer$, BufPosn, 1) = UserKey$
RETURN
MoveLeft:
' move characters left on delete or backspace
   SaveYCoord = YCoord
   FOR YCoord = SaveYCoord + 1 TO Ywindow + Columns - 1 STEP 1
      GOSUB ComputeBufPosn
      OldChar$ = MID$(Buffer$, BufPosn, 1)
      LOCATE XCoord, YCoord - 1, 0
      PRINT OldChar$;
      MID$(Buffer$, BufPosn - 1, 1) = OldChar$
   NEXT YCoord
   MID$(Buffer$, BufPosn, 1) = " "
   LOCATE XCoord, YCoord - 1, 1
   PRINT " "
   YCoord = SaveYCoord
   GOSUB ComputeBufPosn
RETURN

MoveRight:
' move characters right on insert

   SaveYCoord = YCoord
   FOR YCoord = Ywindow + Columns - 2 TO YCoord STEP -1
      GOSUB ComputeBufPosn
      OldChar$ = MID$(Buffer$, BufPosn, 1)
      LOCATE XCoord, YCoord + 1, 0
      PRINT OldChar$;
      MID$(Buffer$, BufPosn + 1, 1) = OldChar$
   NEXT YCoord
   YCoord = SaveYCoord
   GOSUB ComputeBufPosn
   MID$(Buffer$, BufPosn, 1) = " "
   LOCATE XCoord, YCoord, 1
   PRINT " ";
RETURN

LeftWord:
'Find the next word to the left

   GOSUB ComputeBufPosn
   IF BufPosn > 1 THEN BufPosn = BufPosn - 1
   CharsSeen = FALSE
   WordFound = FALSE
   DO
      ThisChar$ = MID$(Buffer$, BufPosn, 1)
      CharsSeen = CharsSeen OR (ThisChar$ <> " ")
      IF CharsSeen AND (ThisChar$ = " ") THEN
         WordFound = TRUE
      ELSE
         BufPosn = BufPosn - 1
      END IF
   LOOP UNTIL WordFound OR BufPosn = 0
   GOSUB ComputeCoords
   LOCATE XCoord, YCoord, 1
RETURN

RightWord:
'Find the next word to the right

   GOSUB ComputeBufPosn
   SpacesSeen = FALSE
   WordFound = FALSE
   DO
      ThisChar$ = MID$(Buffer$, BufPosn, 1)
      SpacesSeen = SpacesSeen OR (ThisChar$ = " ")
      IF SpacesSeen AND (ThisChar$ <> " ") THEN
         WordFound = TRUE
      ELSE
         IF BufPosn < Lines * Columns THEN BufPosn = BufPosn + 1
      END IF
   LOOP UNTIL WordFound OR BufPosn = Lines * Columns
   BufPosn = BufPosn - 1
   GOSUB ComputeCoords
   LOCATE XCoord, YCoord, 1
RETURN

ComputeBufPosn:
' Compute current position within buffer

   BufPosn = ((XCoord - Xwindow) * Columns) + YCoord - Ywindow + 1
RETURN

ComputeCoords:
'Compute screen Coordinates of relative BufPosn

   XCoord = Xwindow + INT(BufPosn / Columns)
   YCoord = Ywindow + (BufPosn MOD Columns)
RETURN

END FUNCTION



 From:  BRIAN MCLAUGHLIN          Sent: 12-02-93 16:48
   To:  DAWNY WEBSTER             Rcvd: -NO-
   Re:  EDITOR IN QB 1.0      1/2

DW>Does anybody here know how to program a text editor in QuickBasic 1.0??
DW>figure out how to use line wrap, or be able to move the cursor up a line, or
DW>how to load a text file for editing. Surely somebody knows how??

Writing a text editor is complicted enough that you'll want to break it
down into lots of pieces (many SUBs and FUNCTIONs).  This code should
give you a start...there's obviously no way to post code for an entire
text editor in one swoop! Even if I could, that would rob you of the
joy of discovery <grin>.

For line wrapping you might think about searching for a break between
words, by searching _backwards_ for the space nearest the end of a line
that is too long, using FOR/NEXT with STEP -1.

' LINEEDIT.BAS

DECLARE FUNCTION LineEdit$ (Row%, Col%, EntryLen%, Prompt$)

Row% = 4: Col% = 4
EntryLen% = 55           'number of spaces the entry can occupy
Prompt$ = "Write here: "

CLS
OutString$ = LineEdit$(Row%, Col%, EntryLen%, Prompt$)
LOCATE CSRLIN + 2, 4
PRINT "You said:   "; OutString$
END

'====================================================
 FUNCTION LineEdit$ (Row%, Col%, EntryLen%, Prompt$)
'====================================================

  CONST TRUE = -1, FALSE = 0

  DO: LOOP WHILE LEN(INKEY$)  'clears any impending keys
  LOCATE Row%, Col%

  PRINT Prompt$;
  Col% = POS(0)
  AllLength% = Col% + EntryLen%
  IF AllLength% > 79 THEN EntryLen% = EntryLen% - (AllLength% - 80)

  SHOW$ = STRING$(EntryLen%, CHR$(176))   'use squares
  PRINT SHOW$;
  LOCATE Row%, Col%, 1, 7, 1              'a big cursor

' -----------------------------
' START OF MAIN PROCEDURE LOOP
' -----------------------------

 DO                                   'it keeps going and going and going
      DO
        Akey$ = INKEY$                ' wait for some kind of input
      LOOP UNTIL LEN(Akey$)

      IF LEN(Akey$) = 1 THEN
         Ky% = ASC(Akey$)
      ELSE                       'it must be an extended key like F1
         Char2$ = RIGHT$(Akey$, 1)
         Ky% = ASC(Char2$) * -1  'convert the keycode to a negative number
      END IF

      SELECT CASE Ky%
        CASE 13                       'on ENTER break out of LOOP
           EXIT DO
        CASE -75                      ' on LEFT ARROW move left one position
          IF (Cpos% > 0) THEN
             Cpos% = Cpos% - 1
             LOCATE Row%, Col% + Cpos%
          END IF
        CASE -77                      ' on RIGHT ARROW move right
          IF (Cpos% < Length%) THEN
             Cpos% = Cpos% + 1
             LOCATE Row%, Col% + Cpos%
          END IF
        CASE -79                      ' on END go to end of line
          Cpos% = Length%
          LOCATE Row%, Col% + Cpos%
        CASE -71                      ' on HOME go to start of line
          Cpos% = 0
          LOCATE Row%, Col% + Cpos%
        CASE -83                      ' on a DEL keypress
          IF (Length% > 0) AND (Cpos% < Length%) THEN
             Temp1$ = LEFT$(OutPut$, Cpos%)
             Temp2$ = RIGHT$(OutPut$, Length% - Cpos% - 1)
             OutPut$ = Temp1$ + Temp2$
             Length% = Length% - 1
             LOCATE Row%, Col%
             PRINT OutPut$ + CHR$(176);
             LOCATE Row%, Col% + Cpos%
          END IF
        CASE 8                        ' on BACKSPACE
          IF (Length% > 0) AND (Cpos% > 0) THEN
             Temp1$ = LEFT$(OutPut$, Cpos% - 1)
             Temp2$ = RIGHT$(OutPut$, (Length% - Cpos%))
             OutPut$ = Temp1$ + Temp2$
             Length% = Length% - 1
             Cpos% = Cpos% - 1
             LOCATE Row%, Col%
             PRINT OutPut$ + CHR$(176);
             LOCATE Row%, Col% + Cpos%
          END IF
        CASE 32 TO 126              'our "printable" characters
          IF (Length% < EntryLen%) THEN
             Temp1$ = LEFT$(OutPut$, Cpos%)
             Temp2$ = RIGHT$(OutPut$, Length% - Cpos%)
             OutPut$ = Temp1$ + CHR$(Ky%) + Temp2$
             Length% = Length% + 1
             Cpos% = Cpos% + 1
             LOCATE Row%, Col%
             PRINT OutPut$;
             LOCATE Row%, Col% + Cpos%
          END IF
      END SELECT
 LOOP

  LOCATE , , 0           'turns the cursor off
  LineEdit$ = OutPut$

END FUNCTION



'Msg #:  2475                      QUIKBAS Subboard
' From:  SAM JONES                 Sent: 12-03-93 15:30
'   To:  ALL                       Rcvd: 12-07-93 13:26
'   Re:  HUFFMAN COMP
'
'Hey all, well I a recently got a Hufman algrorithm for BASIC. Sadly it
'was made only for PowerBasic and I use QuickBasic.  Could some of you
'guys out there with both QB/PB experience possibly modify the code ??

CLS
InFile$="A SIMPLE STRING TO BE ENCODED USING A MINIMAL NUMBER OF BITS"

CALL Huffman(InFile$,OutFile$,NewFile$)
print:print:print
PRINT "In:  ";LEN(InFile$);InFile$
PRINT "Out: ";LEN(OutFile$)
PRINT "New: ";LEN(NewFile$);NewFile$
input,r

END
'**********************************************************************
'   Huffman Encoding File Compression Technique
'
'   From: R Sedgwick.  Algorithms.  Reading, MA: Addison-Wesley.
'                      1984.  Second Ed.  pp  286 / 93.
'
'   Converted to Power Basic by M. Rosenberg CI$: [73707,2545]
'
SUB Huffman(InText$,OutText$,NewText$)
    SHARED N%,Heap%(),Count%()
    DIM Count%(1024),Heap%(1024),Dad%(1024),Code%(256),Leng%(256)

' Count the frequency of each character in the message to be encoded (P. 287)
    FOR I%=0 to 255 : Count%(I%)=0 : NEXT I%
    Csr%=0
    DO : INCR Csr% : X%=ASC(MID$(InText$,Csr%,1)) : INCR Count%(X%)
         LOOP UNTIL Csr%=LEN(InText$)

' Initialize the heap array to point to non-zero frequency counts (P. 290)

    N%=0 : FOR I%=0 to 255 : IF Count%(I%)<>0 THEN INCR N% : Heap%(N%)=I%
           NEXT I%
' Construct an indirect heap on the frequency values (P. 289)

    FOR K% = N% TO 1 STEP -1 : CALL PqDownHeap(K%) : NEXT K%

' Construct the trie (P. 290)
    DO : T%=Heap%(1) : Heap%(1)=Heap%(N%) : DECR N%
             CALL PqDownHeap(1)
             Count%(255+N%)=Count%(Heap%(1))+Count%(T%)
             Dad%(T%)=255+N% : Dad%(Heap%(1))=-255-N%
             Heap%(1)=255+N% : CALL PqDownHeap(1)
    LOOP UNTIL N%=1
    Dad%(255+N%)=0

' Reconstruct the information from the representation of the coding tree (P.291)
'    computed during the sifting process.

    FOR K% = 0 TO 255
        IF Count%(K%)=0 THEN
           Code%(K%)=0 : Leng%(K%)=0
        ELSE
           I%=0 : J&=1 : T%=Dad%(K%) : X%=0
           DO : IF T%<0 THEN X%=X%+J& : T%=0-T%
                T%=Dad%(T%) : J&=J&+J& : INCR I%
           LOOP UNTIL T%=0
           Code%(K%)=X% : Leng%(K%)=I%
        END IF
    NEXT K%
' Use the computed representations of the code to encode the string (P. 292)

    J%=0 : OutText$="" : Hold$=""
    DO : INCR J%
             Char%=ASC(MID$(InText$,J%,1)) : Compr$=BIN$(Code%(Char%))
             DO WHILE LEN(Compr$)< Leng%(Char%) : Compr$="0"+Compr$ : LOOP
             Hold$=Hold$+Compr$
             IF LEN(Hold$)>8 THEN

                OutText$=OutText$+CHR$(Bin2Int(LEFT$(Hold$,8))) Hold$=RIGHT$(Hold$,LEN(Hold$)-8)
             END IF
    LOOP UNTIL J%=LEN(InText$)

' Add a byte at the end that contains any left-over bits

    IF LEN(Hold$)>0 THEN
             Hold$=Hold$+STRING$(8-LEN(Hold$),"0")
             OutText$=OutText$+CHR$(Bin2Int(LEFT$(Hold$,8)))
    END IF
'**********************************************************************
' Unpack compressed string into character representation of binary

    J%=0 : UnCompr$="" : NewText$=""
    DO : INCR J%
         Hold$=MID$(OutText$,J%,1) : Hold$=BIN$(ASC(Hold$))
         DO WHILE LEN(Hold$)<8 : Hold$="0"+Hold$ : LOOP
         UnCompr$=UnCompr$+Hold$
    LOOP UNTIL J%=LEN(OutText$)

' Decode compressed string

    DO : FOR  K%=1 TO 256
         IF K%=256 THEN EXIT LOOP 'All done
         IF Leng%(K%)>0 THEN
            IF Bin2Int(LEFT$(UnCompr$,Leng%(K%)))=Code%(K%) THEN

               UnCompr$=RIGHT$(UnCompr$,LEN(UnCompr$)-Leng%(K%))
               NewText$=NewText$+CHR$(K%) : EXIT FOR
            END IF
        END IF
        NEXT K%
    LOOP UNTIL LEN(UnCompr$) = 0


END SUB 'Huffman

SUB PqDownHeap(K%)
' Build and maintain an indirect heap on the frequency values (P. 139)
'     reversing the inequalities since we want the smallest values first.

    SHARED N%,Heap%(),Count%()
    LOCAL J%,V%,Limit%
    V%=Heap%(K%) : Limit% = N%/2
    DO WHILE K% <= Limit%
       J%=K%+K%
       IF J%<N% THEN IF Count%(Heap%(J%)) > Count%(Heap%(J%+1)) THEN INCR J%
       IF Count%(V%)<=Count%(Heap%(J%)) THEN Heap%(K%)=V% : EXIT SUB
       Heap%(K%)=Heap%(J%) : Heap%(J%)=V% : K%=J%
    LOOP
END SUB 'PqDownHeap

'**********************************************************************
FUNCTION Bin2Int(X$)
X$=RTRIM$(X$) :X$=LTRIM$(X$) : Ll%=LEN(X$) : Ex%=0 : Tot%=0 : I%=Ll%
    DO WHILE I% > 0
        IF MID$(X$,I%,1)="1" THEN Tot&=Tot&+(2^Ex&)
        INCR Ex& : DECR I% : WEND
    Bin2Int=Tot&
END FUNCTION 'Bin2Int





Msg #:  2575                      QUIKBAS Subboard
 From:  CALVIN FRENCH             Sent: 12-06-93 00:00
   To:  ALL                       Rcvd: -NO-
   Re:  HEH...


   * M * E * R * R * Y  C * H * R * I * S * T * M * A * S * !

   Awhile back there was some kind of wierd QB "demo" contest.
Anyways I wrote a little demo but it really wasn't all that good and
the contest sort of died, so I've decided to give it to you all as
a merry christmas present!

   Here's what to do to run this happy little 3 part demo. Take the
message "GRAPHIC1" and save it to disk. Take it into Qb, edit out all
the non-qb text, run it. Then make a directory C:\DEMO (or whatever) and
PKUNZIP GRAPHICS.ZIP to C:\DEMO (or whatever). Next, save the .BAS file
messages to the same directory (you should save everything to that
directory so you can delete it afterwards). Run the file DEMOPREP.BAS
first. It should generate "SURPRISE.PIC"... (you'll have some idea when
you see it). Now, you should have a bunch of .GFX files (made in Tile
Draw), SURPRISE.PIC, and CALVIN.BAS. That's it. Compile CALVIN.BAS,
unload EMM386/SMARTDRV (they slow things down a LOT) and run it! Have
fun everybody, and merry christmas!

   - Calvin -

... Never enter a battle of wits unarmed.
___ Blue Wave/QWK v2.12

--- Maximus 2.01wb
 * Origin: RJ's Byteline =[HST/DS]= Calgary [phone] CANADA
(1:134/75)



Msg #:  2576                      QUIKBAS Subboard
 From:  CALVIN FRENCH             Sent: 12-06-93 00:00
   To:  ALL                       Rcvd: -NO-
   Re:  [1/1] GRAPHICS.ZIP

'>>> Page 1 of GRAPHICS.ZIP begins here. TYPE:BINAA TLEN:2990
DEFINT A-Z:DIM SHARED K,S,B&,Z&:V1 'Created by PostIt! 7.1
SUB V1:OPEN "O",1,"GRAPHICS.ZIP",4^6:Z&=2990:?STRING$(50,177);
U"%up()%9%%%[-%b)8%#Z?*D8$%7%%\%%%%1%%%%FU%UUUU%UVSlpk'\\&2e,/7-%
U"[NCGO'W&z)(uu'3332iyYWhkzPC(jdz(7'I'O7-E1O8/%$OChO7%JJv+T*_5y%%
U"%up(%)9%%%%-%s$)%#8/lBz_[%%%\%%%%1%%%%F%UUUU%UUWSdlk'\*\2e(a/A%
U"A%zi%UA&.+oM+DDD#Zz:4C]&(d/ZOz+.)m+z.5e?z99%Gz\U%J%<oq3/6NFw%%%
U"up(%)9%%%%-%lE)%#V)+8$c[%%%\%%%%1%%%%F%UUUU%UUXSdlk'\<\29%[/U%_
U"%NG%m%sv.+R9:9+2DDDZ.z:4]J&(dZ(Oz+)(m+z5^e?z9F%GzU[%=<RJ-Y&p'4>
U"*%%%up(%)9%%#%-%'E)%#=7Uy1e[%%%\%%%%1%%%%F%UUUU%UUYSdlk'\<\29)[
U"/5%^FN;%S&v)(EN7QqaZ333iVyY+aJq'SzGPCjd%z('I''O-E01O/%'$Oh%2gZ5
U"Tr3zIV&[1%u%p()9%%%%-U%0)%X#*Yq'ri%%+%\%%%%1%%%%FUU%UUUU%ZSlkY'
U"\\2'9'9eF%?vS%&-t.#+9F+2DDDZ.z:4Un&&AN)OA:E_+D9'#?5E#[zf%:%z&(-
U":<7+W+)9Qg9*<Fz*a=k+%%up(%)9%%#%-%i)E&#s9b5Si[%%%\%%%%1%%%%F%UU
U"UU%UU[Sdlk'\<\29+%9995#Aj-O3kc/%gGvs'Q''uy5q%s-$^9E17/m+/,/'?5(
U"E#zfa%C*c[z&(1+vC5%WZqRZ0gOC\%H&%u%p()9%%%%-L%sE&a#vFm%m\%%+%\%
U"%%%1%%%%FUU%UUUU%\SlkY'\\2%E-9FF%CxQL&WkaZ333iVyY+aLGczP0Cjdz[(
U"'I'[O-E1^O/%$#Oh%S_Z5T3,zi%%%up()%9%%%R-%%E/&#U,%*P$%7%%\%%%%1%
U"%%%FU%UUUU%U]Slpk'\\&2E'M%OOG][o5%\Mxzzz)xyMP-:1?mn+j1%1GSz+.)m
U"+z15O#>8cy9%)=cW):M0.<9Vz1&%%up(%)9%%[%-%.DE&#]*Yi'W[%%%\%%%%1%
U"%%%F%UUUU%UU^Sdlk'\*\2E>CMP%ktv'''2uyq18bxP%MBd/+8D9'?.5E#z7f%:
U"z#&(=f#f>'?'QpY%%%up(%)9%%[%-%5)E&#B27XwZ[%%%\%%%%1%%%%F%UUUU%U
U"VUSdlk'\*\2EB%MNNFujMNN%yz5a.25&>&uwBQ\z1z(&s+)mA+z5O\B>y9Ie>=e
U"mW-Y-)f'%%%up()%9%%%R-%<EA&#p['_XM%7%%\%%%%1%%%%FU%UUUU%VVSlpk'
U"\\D2o9wMzzxy(EG?E''Wg7)Tz+)(m+z5^e?z94%G4u%+&+o%&%up%()9%%%%-%3
U"BE&#qNni)%Q%%%'\%%%%1%%%%FUUU%UUVW#Slk'Q\\2oL=wzxFGjYOJ+:Sk1_Wz
U"1*\y&&(7&:)(5++:%5eWp2((h=+,Y,%%up()%9%%%R-%JEe&#z?%L;D%7%%\%%%
U"%1%%%%FU%UUUU%VXSlpk'\\)2o[u\&xj_+&2O-*'i?/A&:-_'11OO9Aac%%%up(
U"%)9%%[%-%Q)E&#I3:V$6[%%%\%%%%1%%%%F%UUUU%UVYSdlk'\3\2oZRuh^x;xq
U"iv,H-%%%up()%9%%%R-%TEJ&#d',180%7%%\%%%%1%%%%FU%UUUU%VZSlpk'\\)
U"2oXu)2oX%%%up(%)9%%#%-%C_o=#Y1lr89[%%%\%%%%1%%%%k%twrU%UUVSdlk'
U"\B\xU&Re+_w[%r;A&4e'h&Q0%u%p()9%%%%-I%5q=##ken&[]%%+%\%%%%1%%%%
U"ktw%rUUU%WSlkY'\\2%e,/mF%=XV.(E.&#ig%_j*]QM^eCf1n?xA_4O9[w,OCfQ
U"1WV*0o[G2Cn+&NF:/7w&%%up(%)9%%#%-%;)s=#T2oWOM[%%%\%%%%1%%%%k%tw
U"rU%UUXSdlk'\*\2e(a/A%A%Zl%U%<I1J<9+S6DwEe+#%9'BCfK*w15yr>'I&%u%
U"p()9%%%%-L%dp=m#;%3'F]%%+%\%%%%1%%%%ktw%rUUU%YSlkY'\\2B9+9OL%X6
U"=k='OE.xe?f[a)<=h2OB::a3''((-S-[em*)hl?o9d%6TDgGjOe&7+Q%%%up(%)
U"9%%[%-%,_p=#p&-\q^[%%%\%%%%1%%%%k%twrU%UUZSdlk'\*\2e(#/5%4IUMgR
U"C%W0uO9EPQ0_5(-^<[fsb7;*T4)$QQJ&UV##FsX&kOcRiJpSVJ)SP&%%up&'%9%
U"9%%%%-%4b)%#TZ?D8%$%%%'\%%%%1%%%%%%%%%&%E%%%%%%%%%FU%UUUU%UVSl(
U"k'up%&'9%%9%%%[-%s)S%#8l(Bz_%7%%\%%%%1%%%%%%%%%&%%E%%%&4%%%%FUU
U"U%UUUW#Slk'%up&'%9%9%%%%-%4l)%#2V+8$%c%%%'\%%%%1%%%%%%%%%&%E%7%
U"%B%%%%FU%UUUU%UXSl(k'up%&'9%%9%%%d-%')/%#=U+y1e%7%%\%%%%1%%%%%%
U"%%%&%%E%%%%V&%%%FUUU%UUUY#Slk'%up&'%9%9%%%%-%50)%#l*Yqr%i%%%'\%
U"%%%1%%%%%%%%%&%E%.%%j&%%%FU%UUUU%UZSl(k'up%&'9%%9%%%I-%iE\&#sb+
U"5Si%7%%\%%%%1%%%%%%%%%&%%E%%%%.'%%%FUUU%UUU[#Slk'%up&'%9%9%%%%-
U"%2sE	vFmm%\%%%'\%%%%1%%%%%%%%%&%E%.%%F'%%%FU%UUUU%U\Sl(k'up%&
U"'9%%9%%%R-%%E/&#U,%*P$%7%%\%%%%1%%%%%%%%%&%%E%%%'Q'%%%FUUU%UUU]
U"#Slk'%up&'%9%9%%%%-%3.E]Yi'%W%%%'\%%%%1%%%%%%%%%&%E%%%%b(%%%
U"FU%UUUU%U^Sl(k'up%&'9%%9%%%R-%5EA&#B7)XwZ%7%%\%%%%1%%%%%%%%%&%%
U"E%%%&h(%%%FUUU%UUVU#Slk'%up&'%9%9%%%%-%3<E&#:p[_X%M%%%'\%%%%1%%
U"%%%%%%%&%E%7%%q(%%%FU%UUUU%VVSl(k'up%&'9%%9%%%R-%BEJ&#Nn-i)Q%7%
U"%\%%%%1%%%%%%%%%&%%E%%%%o)%%%FUUU%UUVW#Slk'%up&'%9%9%%%%-%3JE&#
U",z?L;%D%%%'\%%%%1%%%%%%%%%&%E%.%%o)%%%FU%UUUU%VXSl(k'up%&'9%%9%
U"%%R-%QE\&#I:)V$6%7%%\%%%%1%%%%%%%%%&%%E%%%'b)%%%FUUU%UUVY#Slk'%
U"up&'%9%9%%%%-%3TE&#hd'18%0%%%'\%%%%1%%%%%%%%%&%E%%%%I*%%%FU%UUU
U"U%VZSl(k'up%&'9%%9%%%I-%Co8=#Yl)r89%7%%\%%%%1%%%%%%%%%&%%E%%%&(
U"*%%%ktwr%UUUV#Slk'%up&'%9%9%%%%-%15q=#Iken[%]%%%'\%%%%1%%%%%%%%
U"%&%E%.%%f*%%%kt%wrUU%UWSl(k'up%&'9%%9%%%I-%;sA=#To)WOM%7%%\%%%%
U"1%%%%%%%%%&%%E%%%'r*%%%ktwr%UUUX#Slk'%up&'%9%9%%%%-%2dp=#s;%3F%
U"]%%%'\%%%%1%%%%%%%%%&%E%%%%p+%%%kt%wrUU%UYSl(k'up%&'9%%9%%%R-%,
U"pS=#p-%\q^%7%%\%%%%1%%%%%%%%%&%%E%%%'&+%%%ktwr%UUUZ#Slk'%up*+%%
U"%%%%9%9%&W)%%%5,%%%%%
END SUB
CLOSE:IF S=243AND B&=Z&THEN?" :) Ok!"ELSE?" :( Bad!
SUB U(A$):FOR A=1TO LEN(A$):C=ASC(MID$(A$,A))-37:IF C<0THEN C=91+C*32
IF K<4THEN K=C+243ELSE?#1,CHR$(C+(K MOD 3)*86);:K=K\3:B&=B&+1
S=(S+C)AND 255:NEXT:LOCATE,1:?STRING$(B&*50\Z&,219);:END SUB
'>>> Page 1 of GRAPHICS.ZIP ends here. Last page. TCHK:243



Msg #:  2577                      QUIKBAS Subboard
 From:  CALVIN FRENCH             Sent: 12-06-93 00:00
   To:  ALL                       Rcvd: -NO-
   Re:  [1/2] DEMOPREP.BAS

'>>> Page 1 of DEMOPREP.BAS begins here. TYPE:BAS
DEFINT A-Z

DECLARE SUB TransArray ()
DECLARE SUB CalcTables (sine(), cosi(), logi())
DECLARE SUB SaveImage ()
DECLARE SUB Mode13h ()
DECLARE SUB Mode03h ()
DECLARE SUB SetPalette ()
DECLARE SUB SetPalColour (Colour, Red, Green, Blue)
DECLARE SUB SetColor (x, y, Colour)

DIM sine(360)
DIM cosi(360)
DIM logi(360)

CalcTables sine(), cosi(), logi()
Mode13h
SetPalette
TransArray
SaveImage
Mode03h

END

SUB CalcTables (sine(), cosi(), logi())

PRINT
PRINT "This creates a little picture for use in my QB demo..."
PRINT "Calvin French 1993"
PRINT
PRINT "Please wait. I'm calculating some tables."
PRINT
YLoc = CSRLIN
PRINT STRING$(80, 176);

FOR n = 1 TO 360
  sine(n) = SIN(n / 57) * 1024
  cosi(n) = COS(n / 57) * 1024
  logi(n) = LOG(n / 57) * 1024
  LOCATE YLoc, 1
  PRINT STRING$(n / 360 * 80, 177);
NEXT n

END SUB

SUB Mode03h

SCREEN 0
WIDTH 80

END SUB

SUB Mode13h

SCREEN 13

END SUB

SUB SaveImage

DEF SEG = &HA000
BSAVE "SURPRISE.PIC", 0, 64000
DEF SEG

END SUB

SUB SetColor (x, y, Colour)

'DEF SEG = &HA000
'POKE (x + y * 320), Colour
'DEF SEG

PSET (x, y), Colour

END SUB

SUB SetPalColour (Colour, Red, Green, Blue)

OUT &H3C8, Colour
OUT &H3C9, Red
OUT &H3C9, Green
OUT &H3C9, Blue

END SUB

SUB SetPalette

FOR k = 0 TO 15 STEP 1
  FOR l = 0 TO 15 STEP 1
    SetPalColour k + 15 * l + 1, 4 * (k MOD 15), 4 * (l MOD 15), 63


'                        setpalcol(k+15*l+1,4*(k%15),4*(l%15),63);
'                        setpalcol(0,0,0,0);
  NEXT l
NEXT k

END SUB

SUB TransArray

SHARED sine()
SHARED cosi()
SHARED logi()

FOR d& = 1 TO 360
  FOR r = 1 TO 360
    z = logi(d&) \ 32
    IF z = 0 THEN z = 1
    x = 160 + (sine(r) * d&) \ 1024
    y = 100 + ((cosi(r) * d&) \ 1024 * 2) - z
    c = ((r * 2) MOD 15) + 15 * ((d& * 3) MOD 15) + 1
    LINE -(x, y), c
  NEXT
NEXT

END SUB

 From:  CALVIN FRENCH             Sent: 12-06-93 00:00
   To:  ALL                       Rcvd: -NO-
   Re:  [1/6] CALVIN.BAS

'>>> Page 1 of CALVIN.BAS begins here. TYPE:BAS
DEFINT A-Z

DECLARE SUB LoadColorBob (ImgFile$, Img%(), ImgExt%)

DECLARE SUB Welcome ()
DECLARE SUB ColorBobical1 ()
DECLARE SUB ColorBobical2 ()
DECLARE SUB ColorBobical3 ()
DECLARE SUB ByeBye ()

TYPE StarType
  Angle AS INTEGER
  Speed AS INTEGER
  Brite AS INTEGER
  RealX AS INTEGER
  RealY AS INTEGER
  Dis   AS INTEGER
END TYPE

SCREEN 13

RANDOMIZE TIMER

Welcome
ColorBobical1
ColorBobical2
ColorBobical3
ByeBye

END

SIP:
IF t > 5 THEN
  ip = (ip + 1) MOD 5
  IF ip = 0 THEN ip = 1
ELSE
  t = t + 1
END IF
RETURN

SUB ByeBye

SCREEN 0
WIDTH 80
COLOR 15, 3
PRINT "
"+_
"                "
PRINT "  Well, bye! I hope you enjoyed the demo. I diddn't spend a"+_
" whole lot of time   "
PRINT "  on it, granted, but it's okay anyways... Have fun!
"+_
"                "
PRINT "  - Calvin French - FidoNet 1:134/75 (RJ's Byteline)
"+_
"                "
PRINT "
"+_
"                "
COLOR 7, 0
PRINT
PRINT
PRINT

END SUB

SUB ColorBobical1

SCREEN 13
CLS

DIM Img(15, 15, 29)

OUT &H3C8, 0
FOR n = 1 TO 255
  OUT &H3C9, 0
  OUT &H3C9, 0
  OUT &H3C9, 0
NEXT n

LoadColorBob "!0000001.GFX", Img(), 0
LoadColorBob "!0000002.GFX", Img(), 1
LoadColorBob "!0000003.GFX", Img(), 2
LoadColorBob "!0000004.GFX", Img(), 3
LoadColorBob "!0000005.GFX", Img(), 4
LoadColorBob "!0000006.GFX", Img(), 5
LoadColorBob "!0000007.GFX", Img(), 6

LoadColorBob "!0000008.GFX", Img(), 7
LoadColorBob "!0000009.GFX", Img(), 8
LoadColorBob "!0000010.GFX", Img(), 9
LoadColorBob "!0000011.GFX", Img(), 10
LoadColorBob "!0000012.GFX", Img(), 11
LoadColorBob "!0000013.GFX", Img(), 12
LoadColorBob "!0000014.GFX", Img(), 13
LoadColorBob "!0000015.GFX", Img(), 14

FOR n = 15 TO 29
  FOR x = 1 TO 15
    FOR y = 1 TO 15
      Img(x, y, n) = Img(x, y, 15 - (n - 15))
    NEXT
  NEXT
NEXT

n = 1
FOR y = 1 TO 15
  FOR x = 1 TO 15
    PSET (x, y), n
    n = n + 1
  NEXT x
NEXT y

DIM Temp(5000)
GET (1, 1)-(15, 15), Temp

CLS

FOR y = 0 TO 12
  FOR x = 0 TO 20
    PUT (x * 15 + 3, y * 15 + 3), Temp, PSET
  NEXT x
NEXT y

xn = 1
yn = 1

rs = 1
bs = 2
gs = 3

xp = 1

LOCATE 25, 1
PRINT SPACE$(40);

DO

  IF ballistic THEN
    xn = (xn - yn) MOD 15
    yn = (yn + xn) MOD 15
    xn = xn + RND + 315
    yn = yn + RND + 315
    xn = xn MOD 15
    yn = yn MOD 15
  ELSE
    deg = (deg + 2) MOD 360
    xn = SIN(deg / 55) * 15 + 15
    yn = COS(deg / 55) * 15 + 15
  END IF

  IF supercolor THEN
    r = r + rs
    g = g + gs
    b = b + bs
    IF r = 60 OR r = 0 THEN
      rs = -rs
    END IF
    IF g = 61 OR g = 0 THEN
      gs = -gs
    END IF
    IF b = 62 OR b = 0 THEN
      bs = -bs
    END IF
  END IF

  OUT &H3C8, 1
  FOR x = 1 TO 16
    xa = (xn + x) MOD 15
    FOR y = 1 TO 15
      ya = (yn + y) MOD 15

      IF Img(xa, ya, ip) THEN
        nr = Img(xa, ya, ip) + r
        ng = Img(xa, ya, ip) + g
        nb = Img(xa, ya, ip) + b
      ELSE
        nr = Img(xa, ya, ip)
        ng = Img(xa, ya, ip)
        nb = Img(xa, ya, ip)
      END IF

      OUT &H3C9, nr
      OUT &H3C9, ng
      OUT &H3C9, nb
    NEXT
  NEXT

  IF sp \ 8 > 904 THEN
    supercolor = 1
  END IF

  IF sp \ 8 > 1340 THEN
    ballistic = 1
  END IF

  ip = (ip + 1) MOD 30

LOOP UNTIL LEN(INKEY$)

REDIM Img(0, 0, 0)

END SUB

SUB ColorBobical2

CLS

SCREEN 13

OUT &H3C8, 0
FOR n = 1 TO 63
  OUT &H3C9, n
  OUT &H3C9, n
  OUT &H3C9, n
NEXT n

DIM Stars(1 TO 200) AS StarType
DIM Stars1(1 TO 200) AS StarType
DIM Stars2(1 TO 200) AS StarType
DIM Stars3(1 TO 200) AS StarType
DIM OldStars(1 TO 200) AS StarType

FOR n = 1 TO 200

  Stars1(n).Angle = RND * 360
  Stars1(n).Speed = RND * 3 + 1
  Stars1(n).Brite = RND * 10
  Stars1(n).Dis = RND * 200

  Stars2(n).Angle = (n * 3.6) MOD 360
  Stars2(n).Speed = 2
  Stars2(n).Brite = 1
  Stars2(n).Dis = (n * 25) MOD 200

  IF n MOD 3 = 0 THEN
    Stars3(n).Angle = (n * 3.6) MOD 360
    Stars3(n).Speed = 3
    Stars3(n).Brite = 1
    Stars3(n).Dis = n
  ELSEIF n MOD 3 = 1 THEN
    Stars3(n).Angle = ((n + 33) * 3.6) MOD 360
    Stars3(n).Speed = 3
    Stars3(n).Brite = 1
    Stars3(n).Dis = n
  ELSEIF n MOD 3 = 2 THEN
    Stars3(n).Angle = ((n + 66) * 3.6) MOD 360
    Stars3(n).Speed = 3
    Stars3(n).Brite = 1
    Stars3(n).Dis = n
  END IF

NEXT n

DIM S(360) AS INTEGER
DIM C(360) AS INTEGER

FOR n = 0 TO 360
  S(n) = SIN(n / 57.32) * 100 * 1.2
  C(n) = COS(n / 57.32) * 100
NEXT n

CLS

REDIM Temp(5000)

FOR n = 1 TO 200
  Stars(n).Angle = Stars1(n).Angle
  Stars(n).Speed = Stars1(n).Speed
  Stars(n).Brite = Stars1(n).Brite
  Stars(n).Dis = Stars1(n).Dis
NEXT n

DO
  d = (d + 1) MOD 360
  'star.trans.x(n) = (cosine(star.angle(n))) - (sine(star.angle(n))) * star.dis(n)
  'star.trans.y(n) = (sine(star.angle(n))) + (cosine(star.angle(n))) * star.dis(n)
  FOR n = 1 TO 200
    Stars(n).RealX = 160 + (C(Stars(n).Angle) - S(Stars(n).Angle) *_
 Stars(n).Dis) \ 100
    Stars(n).RealY = 100 + (S(Stars(n).Angle) + C(Stars(n).Angle) *_
 Stars(n).Dis) \ 100
    IF Stars(n).RealY < 11 THEN Stars(n).RealY = 200
  NEXT n
  FOR n = 1 TO 200
    PSET (OldStars(n).RealX, OldStars(n).RealY), 0
    PSET (Stars(n).RealX, Stars(n).RealY), Stars(n).Brite + Stars(n)_
.Dis \ 3
    OldStars(n).RealX = Stars(n).RealX
    OldStars(n).RealY = Stars(n).RealY
  NEXT n
  IF rotation <> 0 THEN
    FOR n = 1 TO 200
      Stars(n).Dis = (Stars(n).Dis + Stars(n).Speed) MOD 200
      Stars(n).Angle = (Stars(n).Angle + rotation) MOD 360
    NEXT n
  ELSE
    FOR n = 1 TO 200
      Stars(n).Dis = (Stars(n).Dis + Stars(n).Speed) MOD 200
    NEXT n
  END IF
  sp = sp + 1

  OUT &H3C8, 70
  OUT &H3C9, (1 * sp) MOD 40 + 20
  OUT &H3C9, (2 * sp) MOD 40 + 20
  OUT &H3C9, (3 * sp) MOD 40 + 20

  IF sp \ 8 = 122 THEN
    rotation = 1
  END IF

  IF sp \ 8 = 256 THEN
    rotation = 358
  END IF

  IF sp \ 8 = 512 THEN
    rotation = 0
    FOR n = 1 TO 200
      Stars(n).Angle = Stars2(n).Angle
      Stars(n).Speed = Stars2(n).Speed
      Stars(n).Brite = Stars2(n).Brite
      Stars(n).Dis = Stars2(n).Dis
    NEXT n
  END IF

  IF sp \ 8 = 762 THEN
    rotation = 1
  END IF

  IF sp \ 8 = 1024 THEN
    rotation = 358
  END IF

  IF sp \ 8 = 1256 THEN
    rotation = 0

    FOR n = 1 TO 200
      Stars(n).Angle = Stars3(n).Angle
      Stars(n).Speed = Stars3(n).Speed
      Stars(n).Brite = Stars3(n).Brite
      Stars(n).Dis = Stars3(n).Dis
    NEXT n
  END IF

  IF sp \ 8 = 1512 THEN
    rotation = 1
  END IF

  IF sp \ 8 = 1974 THEN
    rotation = 358
  END IF

LOOP UNTIL LEN(INKEY$)

REDIM Stars1(0) AS StarType
REDIM Stars2(0) AS StarType
REDIM Stars3(0) AS StarType

REDIM Stars(0) AS StarType
REDIM OldStars(0) AS StarType

END SUB

SUB ColorBobical3

SHARED ip
SHARED r
SHARED g
SHARED b

DIM ra(4): DIM ga(4): DIM ba(4)

ra(1) = 30: ga(1) = 10: ba(1) = 10
ra(2) = 10: ga(2) = 30: ba(2) = 10
ra(3) = 10: ga(3) = 10: ba(3) = 30
ra(4) = 30: ga(4) = 10: ba(4) = 30

ON TIMER(2) GOSUB SIP

OUT &H3C8, 0
FOR n = 0 TO 255
  OUT &H3C9, 0
  OUT &H3C9, 0
  OUT &H3C9, 0
NEXT n

DEF SEG = &HA000
BLOAD "SURPRISE.PIC", 0
DEF SEG

els = 1

TIMER ON

DIM Img(15, 15, 4)

LoadColorBob "FORM0001.GFX", Img(), 0
LoadColorBob "FORM0002.GFX", Img(), 1
LoadColorBob "FORM0003.GFX", Img(), 2
LoadColorBob "FORM0004.GFX", Img(), 3
LoadColorBob "FORM0005.GFX", Img(), 4

DO
  r = ra(ip)
  g = ga(ip)
  b = ba(ip)
  xn = xn + 1
  yn = yn + 1
  el = el + els
  IF el > 40 THEN
    els = -els
  ELSEIF el < 1 THEN
    els = -els
  END IF
  OUT &H3C8, 0
  OUT &H3C9, el
  OUT &H3C9, 0
  OUT &H3C9, 0

  FOR x = 1 TO 15
    xa = (xn + x) MOD 15
    FOR y = 1 TO 15
      ya = (yn + y) MOD 15
      IF Img(xa, ya, ip) THEN
        nr = Img(xa, ya, ip) + r
        ng = Img(xa, ya, ip) + g
        nb = Img(xa, ya, ip) + b
      ELSE
        nr = Img(xa, ya, ip) + el
        ng = Img(xa, ya, ip)
        nb = Img(xa, ya, ip)
      END IF
      OUT &H3C9, nr
      OUT &H3C9, ng
      OUT &H3C9, nb
    NEXT
  NEXT
LOOP UNTIL LEN(INKEY$)

END SUB

SUB LoadColorBob (ImgFile$, Img(), ImgExt)

OPEN ImgFile$ FOR BINARY AS #1
a$ = INPUT$(2, 1)
FOR y = 1 TO 15
  FOR x = 1 TO 15
    Img(x, y, ImgExt) = ASC(INPUT$(1, 1))
  NEXT
NEXT
CLOSE #1

END SUB

SUB Welcome

SCREEN 0
WIDTH 80

COLOR 15, 1
CLS

CLS
PRINT "Hello, and welcome to my demo! It's pretty simple but it's fun to watch"
PRINT "in some parts. Anyways, there's no scrolls or anything, although there"
PRINT "*was*, once apon a time... (I removed them because they slowed things"
PRINT "down WAAY too much). There are three parts to the demo:"
PRINT ""
PRINT "   i) Li'l bouncing colorbobs. Just watch it until the movement starts to"
PRINT "      go 'ballistic', that is, the balls jump around EVERYWHERE."
PRINT "  ii) Starfield. Just watch it until you witness 8 changes."
PRINT " iii) Surprise! Watch it for 10 seconds or so..."
PRINT ""
PRINT "Bye! Calvin French (1:134/75)";
DO: LOOP UNTIL LEN(INKEY$)
CLS
PRINT "Okay let's go..."
END SUB



Msg #:  2614                      QUIKBAS Subboard
 From:  SCOTT BAILEY              Sent: 12-05-93 23:28
   To:  AVERY ANTHONY             Rcvd: -NO-
   Re:  MOUSE IN QBASIC

You can use the mouse in Qbasic 1.X with this:

'---cut-here---
DEFINT A-Z
SCREEN 12
CLS

DEF SEG = 0
getseg = 256 * PEEK(207) + PEEK(206)
mousestuff = 256 * PEEK(205) + PEEK(204) + 2

DEF SEG = getseg

IF (getseg OR (mousestuff - 2)) AND PEEK(mousestuff - 2) = 207 THEN
  SCREEN 0
  PRINT "Load your mouse driver!"
  END
END IF

'Reset mouse driver
m1 = 0
CALL absolute(m1, m2, m3, m4, mousestuff)
COLOR 14

'Turn pointer on
m1 = 1
CALL absolute(m1, m2, m3, m4, mousestuff)

DO
  m1 = 3
  CALL absolute(m1, m2, m3, m4, mousestuff)
  IF m2 = 1 THEN LOCATE 2, 1: PRINT "Left button pressed!!"
  IF m2 = 2 THEN LOCATE 2, 1: PRINT "Right button pressed!"
  LOCATE 3, 1: PRINT "Horizontal pos:"; m3
  LOCATE 4, 1: PRINT "Vertical pos:"; m4
LOOP UNTIL m2 = 3
PRINT "Both buttons pressed!"

'Turn pointer off
m1 = 2
CALL absolute(m1, m2, m3, m4, mousestuff)



Msg #:  2694                      QUIKBAS Subboard
 From:  RAY CARSON                Sent: 12-08-93 09:13
   To:  JACK LEMIRE               Rcvd: -NO-
   Re:  SCROLL

Jack Lemire,

JL> I know how to scroll the screen UP and DOWN by using
JL> interrupts, but I can't find a way do make it scroll left
JL> and right like in Lotus 1-2-3, etc...
JL> If you know if it's possible, or how to do it, leave me a message

The following code is slow in the IDE but is reasonably fast when
compiled to an .EXE. You will lose characters that are scrolled off
of the screen unless you put them into an array or if you are working
with known data (arrays/fields) then just reprint. I Hope long lines
don't get wrapped!

DEFINT A-Z      'SCROLL.BAS ~ Ray Carson ~ 1993
DECLARE SUB Scroll (UpperRow, LowerRow, Columns, Direction)
COLOR 15, 1: CLS
LOCATE 4, 2: PRINT CHR$(218); STRING$(76, CHR$(196)); CHR$(191);
LOCATE 8, 2: PRINT CHR$(192); STRING$(76, CHR$(196)); CHR$(217);
FOR X = 5 TO 7
    LOCATE X, 2: PRINT CHR$(179);
    LOCATE X, 79: PRINT CHR$(179);
NEXT
COLOR 14, 1
LOCATE 5, 32: PRINT "RC Software";
LOCATE 6, 32: PRINT "1113 Hillcrest";
LOCATE 7, 32: PRINT "Conroe, Texas 77301";
COLOR 2, 1
LOCATE 6, 10: PRINT "[phone]";
LOCATE 6, 60: PRINT "[phone]";
COLOR 20, 1: LOCATE 10, 35: PRINT "Press Key";
DO: LOOP UNTIL LEN(INKEY$)
CALL Scroll(5, 6, 10, 0)  ' Direction 0 = right
DO: LOOP UNTIL LEN(INKEY$)
CALL Scroll(5, 6, 10, -1) ' Direction -1 = left
COLOR 15, 1: LOCATE 10, 35: PRINT "  Done   ";

SUB Scroll (UpperRow, LowerRow, Columns, Direction)

    DEF SEG = 0
    Address = PEEK(1040) AND 48
    IF Address = 48 THEN
        DEF SEG = &HB000    'mono
    ELSE
        DEF SEG = &HB800    'color
    END IF
    FOR X = 1 TO Columns
        IF Direction = 0 THEN               'Right
            FOR Column = 79 TO 1 STEP -1    'move everything
                FOR Row = UpperRow TO LowerRow
                    Offset = ((Row - 1) * 80 + (Column - 1)) * 2
                    NewColumn = Column + 1
                    NewOffset = ((Row - 1) * 80 + (NewColumn - 1)) * 2
                    Char = PEEK(Offset)
                    Attr = PEEK(Offset + 1)
                    POKE NewOffset, Char
                    POKE NewOffset + 1, Attr
                    POKE Offset, 32
                NEXT
            NEXT
        END IF
        IF Direction = -1 THEN              'Left
            FOR Column = 2 TO 80            'move everything
                FOR Row = UpperRow TO LowerRow
                    Offset = ((Row - 1) * 80 + (Column - 1)) * 2
                    NewColumn = Column - 1
                    NewOffset = ((Row - 1) * 80 + (NewColumn - 1)) * 2
                    Char = PEEK(Offset)
                    Attr = PEEK(Offset + 1)
                    POKE NewOffset, Char
                    POKE NewOffset + 1, Attr
                    POKE Offset, 32
                NEXT
            NEXT
        END IF
    NEXT

END SUB



Msg #:  3392                      QUIKBAS Subboard
 From:  MARK BUTLER               Sent: 12-22-93 23:25
   To:  HOWARD HULL JR            Rcvd: -NO-
   Re:  FILE VIEWER AND LISTING

Once upon a time Howard Hull Jr uttered this mournful cry to All:

 HHJ>   AAGGRHHH,
        ^^^^^^^^
 You took the word out of my mouth. I'm over 42 and married with
children
 ...I couldn't have said it better <Al Bundy type grin>

 HHJ> Does anyone have any simple source code for reading
 HHJ> and viewing a  file.  I have seen several Freeware
 HHJ> and Shareware file viewers,  but would like to
 HHJ> incorporate one into my program.

 Here's a little something I was playing around with some time back. I
 never quite finished it to my satisfaction but you're free to use it,
 abuse it or refuse it, do anything you wish to do with it....

==========================8< Cut Here 8<=============================
'>>> Page 1 of VIEW.ZIP begins here. TYPE:BINAA TLEN:2096
DEFINT A-Z:DIM SHARED K,S,B&,Z&:V1 'Created by PostIt! 7.2
SUB V1:OPEN "O",1,"VIEW.ZIP",4^6:Z&=2096:?STRING$(50,177);
U"%up()%9%'%[-%M3Je#ye<l/7,7%%x;%%%-%.%%%n(j&Sg7fx.=<f=Tk-k0')'aH
U"19gFt9S(Ex4PD#1eeJ%60)QMbr8]hDR&A;G[xVrwSHc.Ub9J,4LvPjR,a#pnsk(
U";fE6hF5E7MF5ENuub4w*5KF\E9>FNSOIWuk0=0B(<Ff7Ds0A<lYiUh5_I6(eFYR
U"gujXb4*$DL1F+lv>c_sHaolY1'SPV\^G8F)+b;c,A=Sr$jQ5]/7?Abu'Tsni?.6
U"dQVS.LjRU.-3W-hiL;Sz.&E8E1;$=cZ:7+1s?*?p5/hZZ>jvtv*LTtOmq3Fap/u
U"=hUJ<?[?j+XnI*Z/G#tKcEIy<)Uh426D+_C1EF:C&Rr?IKb+e#s=V9nqER)Fg+=
U"H;sf3.[Zr6g[2PXNRh+qfQb3[tYMR^k(>a=BU2WeFa(fsw($WRR>UrXv*Q=Iqa^
U"#Z)Nldq#B6h/^L6P:uo,AAD^d*'I7DV1st$Qm\>6xRwTHrKd,Eo*.y\+U[?SnNl
U"'n>+6g;c$/-VxWh%ARc:6*44gxu%,iS'/.3g$fu.&\eeNd,<#iT4/AGg)8%:s&G
U"0ubdPN,eY7egG[-[5>+N%UaNDbbbhyuZ+'+GRyBS_wTb#HDxC/RI]iK#?<+r1-;
U"tnadTi/'u9Q-&Rs)i<sh6PMTjj5vg;5UlJm&2-;0WCYmeB<_.rScLN,#xBl6$)Y
U"8Q-=pA7pC;[AhS:m[pS'Uk'>L-x>W0bnnh,3Ub8da?F.B1qQHiXN[KR;anOUSk>
U"a\AqP*%&c4zg7abnN14E'HSB;f(qu//L;_*81EwaYp^l5ueH^nQk0S_JMaNarak
U")b\I<aB#-]tjP=Z>m[nq+\yj#xU,h*N,qeBOf%a);I\[KV_SfT7/)k0_?dGUC*S
U"$w)^)Y;P--c2L+Z\2jkrhb>Eb))8C_j=Q*:DriBCB%1&5h[7V=h'8rhCUf**ifg
U"'Y=1(pN]:'W<dXfMa4_T(y^2UNeQtqR_'[A1)&=d.lAPq:1A1$=5.FDE<KYBdb5
U"iJ[^v[7L,8Uw[z=RSPbrPK?kU/ul1$21?]AE5S?yKbiq2$81OVCk1-dHIPka'E0
U"v1hF9]hFEM-5U7]N6H7lfG8v8[/&d/P54.DE3[D1&pe7,fB00b(3U40LK0W.%Iz
U"5'I;'kEef>StTWC]hRI*HcJ4HQuC'p-^\4=I*n()3u.R;\s'/68T_.s1gU0;YqI
U"C3v%V#:zO#A*q/?eF/T>CF^*WTdDTn2cwVDA^+e*0>3gHu'5.O=w;(A5NSrl-:E
U"re;MZaA%Gpd:?TC7iQa$u^U&]0&C8h:JQr(/ruoSoQ't>Ml$$IiU_E]oH3LdV[^
U"faHHpKtZUPkKG.CGKWBM&d\^<GW2lZRyZB/7VZWH'#^nVy1E;q(L<agfsXo2Im/
U"^CTf*PjW_u5ahB>k7AWa&Fn+o;TB+8]E$94n;%PId7_eA<ZrgH(4.lI<)CiO2#S
U"M0u54EN#9E_lHq577;)fsaL\X7fblQ[H-J[0.mr_Mfex+*;7X?06%\o1E/():T;
U"xTG$r1q6YD;L<(7dkKY$Ys_GpHvbZR=6yYd_AY)/c6aH.*o;Z<a_^1DoYF-IBM&
U"3O8q[G^\run\1kHaSt-k>WDjw8CtJT]JN2&W53F(?n<xySZoYkSiuvre)dRceNZ
U"?\TFf)<Q^YN%'HY.s,(;<>I86Sy%OSsX#PXsZO=Ao/CQOrJ'i*Id&F%C#<b(o3U
U"?l[+#o&^i;y2HePQ\l<Dq]z7Y[Q$G?w7=wM^U;/:^S_0<c0N8R?9j2E[M=ed.Az
U"w\69PCslg9o)ja,,C[W)Q%TJt\rCmwpWZ'wM:]e8DY]^8Sj)f-k&,XtdZU%hQ*H
U"1SrEr2/NtDWBK>+HiKk41k=nFKG%g^'Q;9Ol:5=HOE++xBl+e';B=\yHK_49R5$
U"4;NGpnUN(LMtz[y)kAcJ&OOw'.EW'BEUB_g/(NfLa^twvY.gH:KSCVFJ)<GQWL$
U"GXP]Vb9Rmi^_sWcW)=H4-r*T6PuP$>t>\tnds\y^Im*d9BBjydK#sJtc^3q6wnF
U"ja^#$LKQTr#.)&So^%b'el7<^k0_1L0=7sYnE^ltwk0f7cug9'Vx7:SVl'ZIl&t
U"\:)Zp(:v7;yq2cV8=OlnWOm2auN3HtCY&K$ZIqXSe<]ZRlR1T[7LPHHJrfH7YVz
U"f[q2JM2yMK4z-Ah2pENw90h7e\:LID;En%:yvBT>4kUFr(V:/iu-zFZckh:_-:/
U"mZ(cYE^&-0##r]r?f6KpPbQKb'luYj2NV^hWP2r;k7h\0i/K236Q'%a#6TCm(O?
U"$uoFT>0Ay>OJ1XKzzH]%3f0H;t_(PniWYhkko(?0vXsZL,(r%'f3Yp+$WQkf_MM
U"C(]woHjgCV#<h-?kf$$2<A5(Gg+4wQed0bsq_xQJUY&]F>4Y-g4tLa[WhG3UMyR
U"p7#g,=aK-aHq]_Gphq2(c/tfgKe6pCe&>an4J.9^YpSFD<Dj*GbD&&je#RiVX)&
U"z2L.7h?9k&in9D=*m/bwv/at3%#wmJ(2JnSsOoBMR*N;c=3_:J<5q5Px^[mo0^?
U":wWx,%up&'%9%9%%'%-%4M3e#Vyel/'7,%%'x;%%%-%%%%%%%%%&%E%%%%%%.%%
U"%n(j&Sg%fxup%*+%%%%%&%%&%[%7%%],%%%%%
END SUB
CLOSE:IF S=55AND B&=Z&THEN?" :) Ok!"ELSE?" :( Bad!
SUB U(A$):FOR A=1TO LEN(A$):C=ASC(MID$(A$,A))-37:IF C<0THEN C=91+C*32
IF K<4THEN K=C+243ELSE?#1,CHR$(C+(K MOD 3)*86);:K=K\3:B&=B&+1
S=(S+C)AND 255:NEXT:LOCATE,1:?STRING$(B&*50\Z&,219);:END SUB
'>>> Page 1 of VIEW.ZIP ends here. Last page. TCHK:55


Buffer.Attributes
        Buffer.FileName = STRING$(13, 32)
        RETURN

 END SUB




Msg #:  3571                      QUIKBAS Subboard
 From:  VICTOR ELLIOTT            Sent: 12-29-93 11:28
   To:  DONALD SCHELLE            Rcvd: -NO-
   Re:  DIRECTORY --> ARRAY, 1/2

This code (with some small modifications) should assemble all directory
information into one array...  You probibly want one for the size, one
for the date, etc.

Modify it near the end where it assembles the array...  I got it to
work the other day, but didn't save a modified copy by itself...

//Vic

-----------------------------
QB4.5 CODE 1/2 FOLLOWS
-----------------------------
'FULLDIR.BAS by Gaylon Hill
'
'CALL FullDir(Dir$(), DirNum, FileDir, Path$, WildCard$)
'Dir$()     - is filled with the directory file names, size, date, & time.
'Dirnum     - returns the number of Dir$() (arrays).
'FileDir    - if FileDir = 1 then sub-directories names are returned,also.
'Path$      - if Path$= "" then the default path is used. Please note,
'             if the Path$ is given then the wildcard will have to be
'             given with the path name.
'             Ex: Path$ = "\MAIN\QB\*.BAS" or Path$ = "A:\*.*"
'WildCard$  - the WildCard$ selects the type of file needed. Use ? or *
'             to narrow the file selection. If WildCard$ = "" then the
'             default is "*.*". This entry has NO EFFECT when the Path$
'             is given.

TYPE FileFindBuf
        DOS            AS STRING * 19
        CreateTime     AS STRING * 1
        Attributes     AS INTEGER
        AccessTime     AS INTEGER
        AccessDate     AS INTEGER
        FileSize       AS LONG
        FileName       AS STRING * 13
END TYPE

TYPE Register
        ax    AS INTEGER
        bx    AS INTEGER
        cx    AS INTEGER
        dx    AS INTEGER
        bp    AS INTEGER
        si    AS INTEGER
        di    AS INTEGER
        flags AS INTEGER
        ds    AS INTEGER
        es    AS INTEGER
END TYPE

DEFINT A-Z
'
SUB FullDir (Dir$(), DirNum, FileDir, path$, WildCard$)

        DIM inreg AS Register, outreg AS Register
        DIM Buffer AS FileFindBuf

        DirNum = 0

        IF WildCard$ = "" THEN
                WildCard$ = "*.*"
        END IF

        IF path$ = "" THEN
' Get Current Drive

                inreg.ax = &H1900
                CALL Interrupt(&H21, inreg, inreg)
                Drive$ = CHR$(65 + inreg.ax MOD 256)
' Get Current Path
                DIM PathSize AS STRING * 64
                inreg.ax = &H4700
                inreg.dx = ASC(Drive$) - 64
                inreg.ds = VARSEG(PathSize)
                inreg.si = VARPTR(PathSize)
                CALL InterruptX(&H21, inreg, inreg)
                path$ = LEFT$(PathSize, INSTR(PathSize, CHR$(0)) - 1)
                path$ = Drive$ + ":\" + path$ + "\" + WildCard$
        END IF
'Set the area where the file information will be stored
        inreg.ax = &H1A00
        inreg.ds = VARSEG(Buffer)
        inreg.dx = VARPTR(Buffer)
        CALL Interrupt(&H21, inreg, outreg)
' Find the first file, if FirstFM=0 then continue.
        inreg.ax = &H4E00
        inreg.cx = 62
        NPath$ = path$ + CHR$(0)
        inreg.dx = SADD(NPath$)
        CALL Interrupt(&H21, inreg, outreg)
        FirstFM = (outreg.ax AND &HF)
'Find the next file(s), if NextFM<>0 then exit.
        IF FirstFM = 0 THEN
                GOSUB MakeFile
                DO
                        inreg.ax = &H4F00
                        inreg.dx = SADD(NPath$)
                        CALL Interrupt(&H21, inreg, outreg)
                        NextFM = outreg.ax AND &HF
                        IF NextFM = 0 THEN
                                GOSUB MakeFile
                        END IF
                LOOP WHILE NextFM = 0
        END IF
        EXIT SUB
MakeFile:
        IF LEFT$(Buffer.FileName, 1) = "." THEN
                RETURN
        END IF

        FSize$ = RIGHT$(SPACE$(8) + STR$(Buffer.FileSize), 8)

        BitT = Buffer.AccessTime
        ahr = 0
        IF BitT < 0 THEN BitT = 32767 + BitT: ahr = 16
        hr = (BitT \ 2048)
        mm = (BitT - (hr * 2048)) \ 32
        hr = ahr + hr
        FTime$ = RIGHT$("00" + LTRIM$(STR$(hr)), 2) + ":" +
RIGHT$("00"+ LTRIM$(STR$(mm)), 2)

        BitD = Buffer.AccessDate
        yr = BitD \ 512
        mo = (BitD - (yr * 512)) \ 32
        da = BitD - (yr * 512) - (mo * 32)
        FDate$ = RIGHT$("0" + LTRIM$(STR$(mo)), 2) + "-" + RIGHT$("0"+LTRIM$(STR$(da)), 2) + "-" + LTRIM$(STR$(80 + yr))

        x = INSTR(Buffer.FileName, ".")
        IF x = 0 THEN
                FileTemp$ = LEFT$(Buffer.FileName + STRING$(12, 32),12)
        ELSE
                FileTemp$ = LEFT$(LEFT$(Buffer.FileName, x - 1) +SPACE$(12), 8) + MID$(Buffer.FileName, x, 4)
        END IF

        IF Buffer.Attributes = 4096 AND FileDir = 1 THEN
                FileTemp$ = MID$(Buffer.FileName, 1, 12)
        END IF

        DirNum = DirNum + 1
        Dir$(DirNum) = FileTemp$ + FSize$ + "  " + FDate$ + "  " +FTime$

        IF Buffer.Attributes = 4096 AND FileDir = 1 THEN
                MID$(Dir$(DirNum), 13, 9) = "<dir>    "
        END IF

        Buffer.Attributes = 0
        Buffer.AccessTime = 0
        Buffer.AccessDate = 0
        Buffer.FileSize = 0
        Buffer.FileName = STRING$(13, 32)
        RETURN
END SUB





Msg #:  3647                      QUIKBAS Subboard
 From:  RICHARD VANNOY            Sent: 12-30-93 18:42
   To:  VICTOR ELLIOTT            Rcvd: -NO-
   Re:  .WORKING CODE. FINALLY! 1

VE> //Vic
VE> QB4.5 CODE 1/2 FOLLOWS
VE> 'FULLDIR.BAS by Gaylon Hill

I couldn't get your code to work.  Yesterday, I finally
decided I absolutely MUST have working "Get all the files in
a DIR" code, so I sat down with 35 (!!) different samples of
code from this and other echoes.  After many hours of
frustration and bug chasing, I finally found TWO samples
that actually worked!  The one I liked best was posted here
(I think) as FILINFO1.BAS, author unknown.  I'll post it
again for those that would like it.
'FILINFO1.BAS
'Load PDS with    QBX /L
DECLARE SUB SetDTA (Segment%, Offset%)
DEFINT A-Z

TYPE RegTypeX
     ax    AS INTEGER
     bx    AS INTEGER
     cx    AS INTEGER
     dx    AS INTEGER
     bp    AS INTEGER
     si    AS INTEGER
     di    AS INTEGER
     flags AS INTEGER
     ds    AS INTEGER
     es    AS INTEGER
END TYPE
DECLARE SUB InterruptX (intnum AS INTEGER, reg AS RegTypeX, reg AS RegTypeX)

TYPE FileType
    Trackinfo AS STRING * 21
    Attribute AS STRING * 1
    FileTime  AS INTEGER
    FileDate  AS INTEGER
    Filesize  AS LONG
    FileName  AS STRING * 13
END TYPE

DIM KeyStroke AS STRING, FileName AS STRING, FileInfo AS FileType
DIM SHARED Regs AS RegTypeX

COLOR 7, 0
CLS

FileName = SPACE$(66)
Col = 1
LOCATE 1, 1, 1, 12, 13
PRINT "Type the name of the file you want information on."

DO
    LOCATE 2, Col

    WHILE LEN(INKEY$): WEND
    DO
        KeyStroke = INKEY$
    LOOP UNTIL LEN(KeyStroke) = 1

    AscKey = ASC(KeyStroke)
    SELECT CASE AscKey
        CASE 27  'ESC
            CLS
            END

        CASE 13
            '--- Create a ASCIIZ string
            FileName = RTRIM$(FileName) + CHR$(0)
            LOCATE 4, 1
            EXIT DO

        CASE 8    'BackSpace
            IF Col > 1 THEN
                Col = Col - 1
                MID$(FileName, 1) = LEFT$(FileName, Col) + SPACE$(1)
                LOCATE 2, Col
                PRINT " ";
            END IF

        CASE IS > 31
            IF Col < 66 THEN
                MID$(FileName, Col) = KeyStroke
                PRINT KeyStroke;
                Col = Col + 1
            END IF
    END SELECT
LOOP


Regs.ax = &H2F00
CALL InterruptX(&H21, Regs, Regs)
DTASeg = Regs.es
DTAOff = Regs.bx

'--- Set the DTA to our record
SetDTA VARSEG(FileInfo), VARPTR(FileInfo)

'--- Attempt to find a match for the filespec
Regs.ax = &H4E00
Regs.cx = 55
'Note:  If you are using QB you must replace SSEG with VARSEG
'Regs.ds = VARSEG(FileName)
Regs.ds = SSEG(FileName)
Regs.dx = SADD(FileName)

CALL InterruptX(&H21, Regs, Regs)
IF Regs.flags AND 1 THEN GOTO DiskError

NumberFound = 1
DO
    EndOfFileName = INSTR(FileInfo.FileName, CHR$(0)) - 1
    PRINT LEFT$(FileInfo.FileName, EndOfFileName); " is ";
    Attribute = ASC(FileInfo.Attribute)
    FOR Counter = 1 TO 5
        SELECT CASE Counter
            CASE 1
                IF Attribute AND 1 THEN PRINT "RO ";
            CASE 2
                IF Attribute AND 2 THEN PRINT "H ";
            CASE 3
                IF Attribute AND 4 THEN PRINT "S ";
            CASE 4
                IF Attribute AND 16 THEN PRINT "A Subdirectory ";
            CASE 5
                IF Attribute AND 32 THEN PRINT "A ";
        END SELECT
    NEXT Counter

    '--- Show the time
    PRINT
    PRINT "It was created at";
    PRINT STR$(ABS((FileInfo.FileTime AND &HF800) \ 2048));        'Hours
    PRINT ":"; LTRIM$(STR$((FileInfo.FileTime AND &H7E0) \ 32));   'Minutes
    PRINT ":"; LTRIM$(STR$((FileInfo.FileTime AND &H1F) * 2));     'Seconds

'FILINFO2.BAS

    '--- Show the date
    PRINT " on";
    '--- The month
    PRINT STR$((FileInfo.FileDate AND &H1E0) \ 32);
    '--- The day
    PRINT "/"; LTRIM$(STR$(FileInfo.FileDate AND &H1F));
    '--- The year
    PRINT "/"; LTRIM$(STR$(((FileInfo.FileDate AND &HFE00) \ 512) + 1980));

    '--- Show the size
    PRINT " and is"; FileInfo.Filesize; " bytes long."
    PRINT

    '--- Reset the DTA to our record in case it moved
    SetDTA VARSEG(FileInfo), VARPTR(FileInfo)

    '--- Try to find another file
    Regs.ax = &H4F00
    CALL InterruptX(&H21, Regs, Regs)

    IF Regs.flags AND 1 THEN GOTO DiskError

    NumberFound = NumberFound + 1
    IF NumberFound = 8 THEN
        PRINT "- More -";
        WHILE LEN(INKEY$): WEND
        DO: LOOP UNTIL LEN(INKEY$)
        NumberFound = 0
        PRINT
    END IF
LOOP

'--- All things being equal, and all roads leading to Rome, the only way out
'    of this program once it is searching, is to come through here.
DiskError:
    SELECT CASE Regs.ax
        CASE &H2
            PRINT "File not found"
        CASE &H3
            PRINT "Invalid path"
        CASE &H12
            PRINT "No more files"
    END SELECT

    '--- In this case, this is pointless, however in a real-world app, other
    '    processes may be using a DTA of their own, so it is good practice to
    '    set the DTA back to what it was when we changed it.

    SetDTA DTASeg, DTAOff
END

SUB SetDTA (Segment, Offset)
Regs.ax = &H1A00
Regs.ds = Segment
Regs.dx = Offset
CALL interrupt(&H21, Regs, Regs)
END SUB






Msg #:  3739                      QUIKBAS Subboard
 From:  HARRY F. HARRISON         Sent: 12-30-93 09:49
   To:  JOHNNY LOUDAKIS           Rcvd: -NO-
   Re:  FILE ATRRIBUTES


 >   I'm needing to be able to turn off file attributes on the fly

Try this: (This is a solid, tested, and bug-free routine).

Valid bits for Attrib%
&H1 - Read Only
&H2 - Hidden
&H4 - System
&H8 - Volume label
&H10 - Sub Directory
&H20 - Archive
&H80 - Shareable (Novell Netware - used to set shareable flag)

'USE the following code fragment as an example.

'Get attributes of a file.
Attrib% = GetFileAttributes%("C:\IO.SYS")
IF Attrib% AND &H2 ' check for 'system' attribute set.
    Attrib% = Attrib% XOR &H2 'Turn it off.
ELSE  'not set
    Attrib% = Attrib% OR &H2  'Turn it on.
ENDIF

'call interrupt to set attributes.
CALL SetFileAttributes("C:\IO.SYS", Attrib%)

DECLARE FUNCTION GetFileAttributes% (FileName$)
DECLARE SUB SetFileAttributes% (FileName$, Attribute%)
'$INCLUDE: '..\include\qbx.bi'

DEFINT A-Z
FUNCTION GetFileAttributes% (FileName$)
    DIM InRegs AS RegTypeX, OutRegs AS RegTypeX
    InRegs.ax = &H4300
    FileNameZ$ = LTRIM$(RTRIM$(FileName$)) + CHR$(0)
    InRegs.ds = SSEG(FileNameZ$)
    InRegs.dx = SADD(FileNameZ$)
    CALL InterruptX(&H21, InRegs, OutRegs)
    GetFileAttributes% = OutRegs.cx
END FUNCTION

SUB SetFileAttributes% (FileName$, Attribute%)
    DIM InRegs AS RegTypeX, OutRegs AS RegTypeX
    InRegs.ax = &H4301
    InRegs.cx = Attribute%
    FileNameZ$ = LTRIM$(RTRIM$(FileName$)) + CHR$(0)
    InRegs.ds = SSEG(FileNameZ$)
    InRegs.dx = SADD(FileNameZ$)
    CALL InterruptX(&H21, InRegs, OutRegs)
END SUB




Msg #:  3819                      QUIKBAS Subboard
 From:  MARK BUTLER               Sent: 01-04-94 02:01
   To:  ALL                       Rcvd: -NO-
   Re:  FIX THAT *$%! "FAST" SAVE

--> Note:
Forwarded (from: ILINK_BASIC) by Mark Butler using timEd.
Original was from Douglas Lusher to Mike Cocke.

MC>DL> Joe Pavorati (sp?) posted a patch for QB4.5 that will make ascii the
MC>DL> default save format instead of quick save/load. Did you get that?

MC>I didn't - do you still have it?  If so, could you please repost it.

              'Patch to by-pass "Fast Save/Load" Bug in QB 4.5
              ' by J. S. Paravati    12/93


  'Note!:  This program will modify a QB.EXE file! Backup your original
  '        file first!

  ' After modifacation takes place the "Fast Load and Save" will
  ' NO LONGER WORK.  No matter where you put the "dot" in the
  ' "Format" box (or ALT F S, or Mouse F then S), your programs will
  ' *ALWAYS* be saved in the ASCII
  ' (Text- Readable by Other Programs) format.

 DEFINT A-Z
 DEFLNG N

 CLS

 F$ = "C:\QB45\QB.EXE"
 F$ = UCASE$(F$)

 OPEN F$ FOR BINARY AS #1
 SK& = &HE9C5
 IF SK& < 0 THEN SK& = SK& + 65536 + 1

  SEEK #1, SK&
    GET #1, , AX: PRINT HEX$(AX), " Original Value Should = Hex 775"

   NewByte = 7 * 256 + &HEB
   SEEK #1, SK&
 PRINT HEX$(NewByte), " New Value Should = Hex 7EB"
 PRINT HEX$(SEEK(1)), " Address Should = E9C6"

 IF HEX$(AX) <> "775" OR HEX$(SEEK(1)) <> "E9C6" THEN
   PRINT
   PRINT "File Already Modified or Wrong Version: Quitting Program"
   CLOSE : END
 END IF

    PUT #1, , NewByte

  SEEK #1, SK&
  GET #1, , AX
  PRINT
  PRINT "File Modified. New Value at "; HEX$(SK&); " = "; HEX$(AX)

 CLOSE
 END





Msg #:  3895                      QUIKBAS Subboard
 From:  BRIAN MCLAUGHLIN          Sent: 01-05-94 10:49
   To:  ALL                       Rcvd: -NO-
   Re:  BIT-TWIDDLING ASM CODE

;---------------------- START ASM CODE -------------------------------
comment | USE WITH QB/PDS.  Assemble with MASM 5.1 or better.

Written by Brian McLaughlin. Released into public domain 1/5/94.
This source code contains two integer FUNCTIONs: SetBit% and GetBit%.

SetBit accepts a target integer and a second paramenter naming the
target bit (0-15) to set or clear, and a third parameter showing
whether to set or to clear the target bit. To clear the target bit, the
third value should be zero. To set the target bit use any non-zero
value. Because SetBit is written as a FUNCTION, the original target
integer WILL NOT be altered, unless you reassign it, using the
value returned by SetBit, like so:

   Target% = SetBit%(Target%, 0, 0)    'sets bit 0 to 0 in Target%

NOTE: Bit position 0 is the furthest "righthand" bit in the Target%,
when it is written in binary notation.

GetBit accepts a target integer, and a second parameter that shows
which bit (0-15) to read. GetBit returns a zero if the bit is zero,
or -1 if the bit is 1. This lets you use IF NOT GetBit%...THEN.

IMPORTANT NOTE: Both these FUNCTIONs give erratic results when passed a
bit position other than 0 through 15.

DECLARE them:     DECLARE FUNCTION SetBit%(Target%, BitPos%, SetOrClr%)
                  DECLARE FUNCTION GetBit%(Target%, BitPos%)
end comment |

.MODEL MEDIUM, BASIC
.CODE

SetBit PROC FAR USES DI, Intgr:WORD, BitPos:WORD, SetIt:WORD
    Mov BX, Intgr    ;BX = address of the target integer
    Mov AX, [BX]     ;AX = value of target integer
    Mov BX, SetIt    ;BX = address of SetIt
    Mov DX, [BX]     ;DX = value of SetIt
    Mov BX, BitPos   ;BX = address of BitPos
    Mov CX, [BX]     ;CX = value of BitPos
    Mov DI, 1        ;set mask (DI) to 00000000 00000001b
    Shl DI, CL       ;DI holds the mask, shift it left CL times
    Cmp DX, 0        ;should the bit be cleared?
    Je  ClrBit       ;if so, then skip ahead
    Or  AX, DI       ;set bit to 1 by ORing with the mask
    Jmp SHORT Exit   ;and return
ClrBit:
    Not DI           ;to clear bit, reverse the mask
    And AX, DI       ;then AND the mask and the target integer
Exit:
    Ret              ;all done!
SetBit ENDP

GetBit PROC FAR USES DI, Intgr:WORD, BitPos:WORD
    Xor AX, AX       ;assume we're returning a zero in AX
    Mov BX, Intgr    ;BX = address of the target integer
    Mov DX, [BX]     ;DX = value of target integer
    Mov BX, BitPos   ;BX = address of BitPos
    Mov CX, [BX]     ;CX = value of BitPos
    Mov DI, 1        ;set mask (DI) to 00000000 00000001b
    Shl DI, CL       ;DI holds the mask, shift it CL times
    And DI, DX       ;AND the mask and the target integer
    Jz  AllDone      ;if zero, the bit WAS clear: return 0 in AX
    Dec AX           ;if not, we need to return a -1 in AX
AllDone:
    Ret
GetBit ENDP
    END
;------------------------- END ASM CODE -----------------------------

What follows is a POSTIT of the OBJ file for the assembly language
code listed above. To retreive the OBJ file in a form you can use, save
this message, load it into QB, delete everything except what falls
between the lines: "*********".  Then press F5 to run the POSTIT code.

'*******************  START POSTIT CODE ************************

'** Save this script to a file, edit out all of the non-QB related
'** text and execute it in a QB environment to retrieve BITS.OBJ
CLS:?STRING$(50,177):?"Creating: BITS.OBJ with PostIt! v2.9f"
DEFINT A-Z:FOR A=0 TO 6:P(A)=2^A:NEXT:OPEN "B",1,"BITS.OBJ"
T$="abcdefghijklmnopqrstuvwxyz":T$=T$+UCASE$(T$)+"0123456789()"
G"aAbaumMoCj2B5fMBCrgBCjwA0nNlHnxBBA5iaaGbeDKupvfujiusun1xuvewura
G"rbrvqem0tevubFruqufK1yEaaiLeaduqahJ5baGeaayabb4GMeaGa)lWxqEbaae
G"GbtvevcLevaaaagCurujusuPcaaGjIeaaaIgq0G2eabaaavTi7xTOxkS4bl6Lbl
G"EXIEHWIp8Baam95dQpa0rWchVob3F9ih)vxkBaavTi7xndWl6fclEXIEzWIp8Ba
G"am95JOpDbG0xDPmbaOSIcaaa0b"
N=208:K=255:IF LEN(C$)<>278 THEN ?"Incomplete script file!":BEEP:END
FOR A=1 TO N:IF L=0 THEN GOSUB G:L=6:LOCATE 1:?STRING$((51&*A)\N,8)
W=T\P(6-L):GOSUB G:W=W OR T*P(L):L=L-2:B$=CHR$(W AND K):PUT 1,,B$:NEXT
?:IF C<>166 THEN ?"Bad checksum!":BEEP:END ELSE ?"Success!":END
G:I=I+1:T=INSTR(T$,MID$(C$,I,1))-1:C=(C+T)*2:C=C\256+(C AND 255):RETURN
SUB G(A$):SHARED C$:C$=C$+LEFT$(A$,63):END SUB




' From:  JOHN WOODGATE             Sent: 10-23-93 15:04
'   To:  ALL                       Rcvd: 10-27-93 08:30
'   Re:  VGA FADEOUT ROUTINE
'
'Hello All!
'
'I've recently written VGA Fade In/Out routines in QB and thought I'd
'share them with ya...

DEFINT A-Z

DECLARE SUB VGAFadeOut ()
DECLARE SUB VGAFadeIn ()
DECLARE SUB ScreenOut ()
DECLARE SUB ScreenIn ()

DIM SHARED Pal&(0 TO 15)

SCREEN 12  ' VGA Required
X = 1: Y = 20
FOR a = 0 TO 7
 LINE (X, Y)-(X + 50, Y + 70), a, BF
 X = X + 65
NEXT a

X = 1: Y = 120
FOR a = 8 TO 15
 LINE (X, Y)-(X + 50, Y + 70), a, BF
 X = X + 65
NEXT a
LOCATE 15, 20: PRINT "You can set all the colors to black, Draw Somthing"
SLEEP 2
CALL ScreenOut
LOCATE 15, 20: PRINT "and then set the colors back to normal. "
SLEEP 2
CALL ScreenIn

SLEEP 4

LOCATE 15, 20: PRINT "You can also fade out the screen, draw somthing "
SLEEP 2
CALL VGAFadeOut
LOCATE 15, 20: PRINT "And then fade back in "
SLEEP 2
CALL VGAFadeIn
SLEEP 3
SCREEN 0: PRINT "Isn't BASIC Neat......."

'


SUB ScreenIn

PALETTE
END SUB

SUB ScreenOut

PALETTE USING Pal&(0)
END SUB

SUB VGAFadeIn

FOR a = 1 TO 63
  IF a <= 43 THEN
   clr& = 65536 * 0 + 256 * 0 + a
   PALETTE 4, clr&
   clr& = 65536 * a + 256 * 0 + 0
   PALETTE 1, clr&
   clr& = 65536 * 0 + 256 * a + 0
   PALETTE 2, clr&
   clr& = 65536 * a + 256 * a + a
   PALETTE 7, clr&
   clr& = 65536 * a + 256 * a + 0
   PALETTE 3, clr&
   clr& = 65536 * a + 256 * 0 + a
   PALETTE 5, clr&
  END IF
  IF a <= 21 THEN
   clr& = 65536 * a + 256 * a + a
   PALETTE 8, clr&
  END IF
  IF a <= 41 THEN
   IF a <= 20 THEN
    clr& = 65536 * a + 256 * a + a
    PALETTE 0, clr&
   ELSE
    clr& = 65536 * 20 + 256 * 20 + a

    PALETTE 6, clr&
   END IF
  END IF

  clr& = 65536 * a + 256 * 0 + a
  PALETTE 13, clr&
  clr& = 65536 * a + 256 * a + 0
  PALETTE 11, clr&
  clr& = 65536 * 0 + 256 * a + a
  PALETTE 14, clr&
  clr& = 65536 * a + 256 * a + a
  PALETTE 15, clr&
  clr& = 65536 * 0 + 256 * 0 + a
  PALETTE 12, clr&
  clr& = 65536 * 0 + 256 * a + 0
  PALETTE 10, clr&
  clr& = 65536 * a + 256 * 0 + 0
  PALETTE 9, clr&
NEXT a


END SUB

SUB VGAFadeOut

FOR a = 63 TO 1 STEP -1
  IF a <= 43 THEN
   clr& = 65536 * 0 + 256 * 0 + a
   PALETTE 4, clr&
   clr& = 65536 * a + 256 * 0 + 0
   PALETTE 1, clr&
   clr& = 65536 * 0 + 256 * a + 0
   PALETTE 2, clr&
   clr& = 65536 * a + 256 * a + a
   PALETTE 7, clr&
   clr& = 65536 * a + 256 * a + 0
   PALETTE 3, clr&
   clr& = 65536 * a + 256 * 0 + a
   PALETTE 5, clr&
  END IF
  IF a <= 21 THEN
   clr& = 65536 * a + 256 * a + a
   PALETTE 8, clr&
  END IF
  IF a <= 41 THEN
   IF a <= 20 THEN
    clr& = 65536 * a + 256 * a + a
    PALETTE 6, clr&
   ELSE
    clr& = 65536 * 20 + 256 * 20 + a
    PALETTE 6, clr&
   END IF
  END IF
  clr& = 65536 * a + 256 * 0 + a
  PALETTE 13, clr&
  clr& = 65536 * a + 256 * a + 0
  PALETTE 11, clr&
  clr& = 65536 * 0 + 256 * a + a
  PALETTE 14, clr&
  clr& = 65536 * a + 256 * a + a
  PALETTE 15, clr&
  clr& = 65536 * 0 + 256 * 0 + a
  PALETTE 12, clr&
  clr& = 65536 * 0 + 256 * a + 0
  PALETTE 10, clr&
  clr& = 65536 * a + 256 * 0 + 0
  PALETTE 9, clr&
NEXT a

END SUB



' From:  JOHN WOODGATE             Sent: 10-23-93 15:04
'   To:  PAT SARNOWSKI             Rcvd: -NO-
'   Re:  BLOAD/BSAVE VGA
'
'I'm not sure if this is exactly what you want, but here goes...

DEFINT A-Z

DECLARE FUNCTION VidMem% ()
DECLARE SUB EgaBSave (FileName$)
DECLARE SUB EgaBLoad (FileName$)
DECLARE SUB VGABSave (FileName$)
DECLARE SUB VGABLoad (FileName$)
DECLARE FUNCTION Monitor% (Segment)


TYPE RegType
  ax    AS INTEGER
  bx    AS INTEGER
  cx    AS INTEGER
  dx    AS INTEGER
  bp    AS INTEGER
  si    AS INTEGER
  di   AS INTEGER
  flags AS INTEGER
END TYPE

DIM SHARED InRegs AS RegType, OutRegs AS RegType
DIM SHARED Video%

SUB EgaBLoad (FileName$) STATIC

' Loads a EGA (640x350) screen from disk
DEF SEG = &HA000
OUT &H3C4, 2: OUT &H3C5, 1
BLOAD FileName$ + ".E01", 0
OUT &H3C4, 2: OUT &H3C5, 2
BLOAD FileName$ + ".E02", 0
OUT &H3C4, 2: OUT &H3C5, 4
BLOAD FileName$ + ".E03", 0
OUT &H3C4, 2: OUT &H3C5, 8
BLOAD FileName$ + ".E04", 0
OUT &H3C4, 2: OUT &H3C5, 15
DEF SEG
END SUB

SUB EgaBSave (FileName$) STATIC


' Saves a EGA (640x350) screen to disk
DEF SEG = &HA000
Size& = 28000
OUT &H3CE, 4: OUT &H3CF, 0
BSAVE FileName$ + ".E01", 0, Size&
OUT &H3CE, 4: OUT &H3CF, 1
BSAVE FileName$ + ".E02", 0, Size&
OUT &H3CE, 4: OUT &H3CF, 2
BSAVE FileName$ + ".E03", 0, Size&
OUT &H3CE, 4: OUT &H3CF, 3
BSAVE FileName$ + ".E04", 0, Size&
OUT &H3CE, 4: OUT &H3CF, 0
DEF SEG
END SUB

FUNCTION Monitor% (Segment) STATIC

DEF SEG = 0              'first see if it's color or mono
Segment = &HB800         'assume color
IF EEK(&H463) = &HB4 THEN

  Segment = &HB000       'assign the monochrome segment
  Status = INP(&H3BA)    'get the current video status
  FOR X = 1 TO 30000     'test for a Hercules 30000 times
    IF INP(&H3BA) <> Status THEN
      Monitor% = 2       'the port changed, it's a Herc
      EXIT FUNCTION      'all done
    END IF
  NEXT
  Monitor% = 1           'it's a plain monochrome

ELSE                     'it's some sort of color monitor

  InRegs.ax = &H1A00     'first test for VGA
  CALL INTERRUPT(&H10, InRegs, OutRegs)
  IF (OutRegs.ax AND &HFF) = &H1A THEN
    Monitor% = 5         'it's a VGA
    EXIT FUNCTION        'all done
  END IF

  InRegs.ax = &H1200     'now test for EGA
  InRegs.bx = &H10
  CALL INTERRUPT(&H10, InRegs, OutRegs)
  IF (OutRegs.bx AND &HFF) = &H10 THEN
    Monitor% = 3         'if BL is still &H10 it's a CGA
  ELSE
    Monitor% = 4         'otherwise it's an EGA
  END IF

END IF
END FUNCTION

SUB VGABLoad (FileName$)

' Loads a VGA (640x480) screen from disk
DEF SEG = &HA000
OUT &H3C4, 2: OUT &H3C5, 1
BLOAD FileName$ + ".V01", 0
OUT &H3C4, 2: OUT &H3C5, 2
BLOAD FileName$ + ".V02", 0
OUT &H3C4, 2: OUT &H3C5, 4
BLOAD FileName$ + ".V03", 0
OUT &H3C4, 2: OUT &H3C5, 8
BLOAD FileName$ + ".V04", 0
OUT &H3C4, 2: OUT &H3C5, 15
DEF SEG
END SUB

SUB VGABSave (FileName$)

' Saves a VGA (640x480) screen to disk
DEF SEG = &HA000
Size& = 38400
OUT &H3CE, 4: OUT &H3CF, 0
BSAVE FileName$ + ".V01", 0, Size&
OUT &H3CE, 4: OUT &H3CF, 1
BSAVE FileName$ + ".V02", 0, Size&
OUT &H3CE, 4: OUT &H3CF, 2
BSAVE FileName$ + ".V03", 0, Size&
OUT &H3CE, 4: OUT &H3CF, 3
BSAVE FileName$ + ".V04", 0, Size&
OUT &H3CE, 4: OUT &H3CF, 0
DEF SEG
END SUB

FUNCTION VidMem%

' Let's you know how much Video RAM is installed
' VGA/EGA Only
DEF SEG = 0
byte = PEEK(&H487)
byte = byte AND 96
byte = byte \ 32
byte = (byte + 1) * 64
VidMem% = byte
END FUNCTION






' From:  STEVE DEMO                Sent: 10-24-93 11:04
'   To:  CHRIS MENNIE              Rcvd: -NO-
'   Re:  (R)FADING OUT
'
' CM> Does anybody have a routine for fading a VGA screen?

'Yep,

DEFINT A-Z
DECLARE SUB Fade2Black (loops)
RANDOMIZE TIMER
SCREEN 13
FOR x = 1 TO 320
 J = INT(RND * 256) + 1
 LINE (x, 1)-(x, 200), J
NEXT
FOR loops = 1 TO 100
    Y = INT(RND * 190) + 1
    x = INT(RND * 310) + 1
    Size = INT(RND * 20) + 1
    Clur = INT(RND * 150) + 31
    CIRCLE (x, Y), Size, Clur
    PAINT (x, Y), Clur, Clur
NEXT
Fade2Black 600
SLEEP 1
PALETTE

SUB Fade2Black (loops)
  DEF SEG = &HA000
  OUT &H3C7, 0
  OUT &H3C8, 0
      FOR CLRS = 1 TO 768
        'Adjust this for Machine Speed It's old fasion
        'but better than clock ticks that look like Stuttering.
        '//////////////////////////
        FOR x = 1 TO loops: NEXT x
        OUT &H3C9, 0
      NEXT CLRS
  DEF SEG
END SUB




Msg #:  2114                      QUIKBAS Subboard
 From:  MIKE AUDLEMAN             Sent: 06-02-94 19:07
   To:  ALL                       Rcvd: -NO-
   Re:  QBFAQ 1

                     The psudo, almost real, semi-
                   ╔═══╗ ╔══╕ ╔══╕ ╥ ╔═══╗ ╥ ╔═══╗ ╥
                   ║   ║ ╠═╡  ╠═╡  ║ ║     ║ ╠═══╣ ║
                   ║   ║ ║    ║    ║ ║     ║ ║   ║ ║
                   ╚═══╝ ╨    ╨    ╨ ╚═══╝ ╨ ╨   ╨ ╚══╛
                                looking
         ╔═══╗  ╥   ╥ ╥ ╔═══╗ ╥  /   ╔═══╗ ╔═══╗ ╔═══╕ ╥ ╔═══╗
         ║   ║  ║   ║ ║ ║     ║ /    ╠═══╣ ╠═══╣ ╚═══╗ ║ ║
         ║  \║  ║   ║ ║ ║     ║/\    ║   ║ ║   ║     ║ ║ ║
         ╚═══╝\ ╚═══╝ ╨ ╚═══╝ ╨  \   ╚═══╝ ╨   ╨ ╘═══╝ ╨ ╚═══╝

                           ╔══╕ ╔═══╗ ╔═══╗
                           ╠═╡  ╠═══╣ ║   ║
                           ║    ║   ║ ║  \║
                           ╨   .╨   ╨.╚═══╝\.
                       Frequently Asked Questions
                      Version 1.0 - Release 6/1/94
                  Written and Created by Mike Audleman
                  Copyright (C) 1994 by Mike Audleman

 Please distribute freely but UNMODIFIED.  If you have contributions,
 you may send them to MIKE AUDLEMAN at FIDO address 1:154/288 or on the
 Quick_Basic FIDO echo.  Please send them as ASCII text only, no
 formatted doccuments (WP, W4WIN etc.).  This is not an OFFICIAL
 document and as such all information is provided ASIS and no warrenties
 are implied as to the acuracy of anything included here.  The questions
 and answers here are take from the Quick_Basic echo that I read weekly
 and reflect general questions that seem to appear on a regular basis. I
 write this in an effort to reduce the load on the net and plan to
 release new or updated versions on a monthly basis unless the load
 seems such that another interval is warrented.

 Since this is NOT a CODE SNIPPIT publication, code here will be limited
 severely.  Only enough code to present information will be included. At
 this time, I do not know if there is anyone maintaining a snippit file,
 but if someone is, please forward the name and fido address that it can
 be freq'd from and I will include the info on it here.

 This publication is not connected in any way to any commercial
 concern, mine or otherwise and is free to all.  No information
 contained herin is to be considered as an advertisment for any product,
 consider it as INFORMATION only.

 One last note, I do not own any version of PDS so I am unable to test
 ANY of the information with regard to that package.  I do have QB45 and
 have tested MOST but NOT all on it.  Additionally, much of this
 information will not be compatible to QBasic provided with MSDOS 5.0
 and above since it is missing many of the features of the full compiler
 version.

                                                 Thank you.
                                                 Mike Audleman
                                                 FIDO: 1:154/280


                                 INDEX
    "How do I get arguments from the command line?"
    "How do I make QB45 stop converting COMMAND$ to uppercase?"
    "How do I make QuickBasic exit with an ErrorLevel?"
    "How do I load QB with two LIBs?"
    "Are there any good books on QuickBasic?"
    "How do I get a number from a string into an Integer?"
    "How do I remove spaces from a string?"
    "What are 'String Descriptors'?"
    "What is the difference between QBASIC and QuickBasic?"
    "How do I convert from a HEX number to DECIMAL or DECIMAL to HEX?"
    "How do I make QuickBasic reboot the system?"
    "Could anybody show me how `INKEY$' works please?"
    "How do you do ARCSIN and ARCCOS?"
    "How do the AND, OR, and XOR work?"
    "How do I seperate command line arguments?"



*>  "How do I get arguments from the command line?"

    Use the COMMAND$ function in QB, QB45 and PDS thus:

            Commandline$=COMMAND$

    One caviat here is that QB and QB45 converts the command line to
    UPPERCASE only.  I am not sure about PDS on the uppercase.

*>  "How do I make QB45 stop converting COMMAND$ to uppercase?"

    One method is to obtain a addon lib that provides direct access to
    the PSP and the unconverted command line.  The LIB I released in
    5/94 on the Quick_Basic net provides this and it is free.  This
    method provides the same capability in the design environment as
    well as when the file is compiled, the patch mentioned next does
    not.  The second method is to apply a patch to one of your QB45
    files. The following patch for QB45 will prevent QB from forcing the
    command line to uppercase.  Once you make this patch, you will have
    to use UCASE$(COMMAND$) to retreive an uppercase only string.

    The following steps will extract the OSCMD.OBJ file from your
    BCOM45.LIB, modify it and then replace it with the modified version.
    As always, MAKE A BACKUP OF BCOM45.LIB FIRST!  One note, this will
    not affect the design environment, it will still force to uppercase.
    When the BAS file is compiled and linked, it will return the command
    line as typed.  I still have not found the correct patch to QB.EXE.

    First, enter the following command:
        LIB BCOM45 *OSCMD

    Then run the following basic program
        Search$ = ""
        FOR X% = 1 TO 10
                READ Y%
                Search$ = Search$ + CHR$(Y%)
        NEXT X%
        Replace$ = CHR$(235) + CHR$(8) + STRING$(8, 144)
        PRINT "OSCMD.OBJ ";
        OPEN "OSCMD.OBJ" FOR BINARY AS 1
        X$ = SPACE$(LOF(1))
        GET 1, , X$
        X% = INSTR(X$, Search$)
        IF X% = 0 THEN PRINT "Not Modified.": CLOSE : END
        MID$(X$, X%) = Replace$
        PUT 1, 1, X$
        CLOSE : PRINT "Modified.": END
        DATA 60,97,114,6,60,122,119,2,52,32

    Now enter the following command:
        LIB BCOM45 -OSCMD +OSCMD,,BCOM45

    You should now have a modified BCOM45.LIB.

*>  "How do I make QuickBasic exit with an ErrorLevel?"

    Add the following declare statement at the beginning of your
    program:

        DECLARE SUB ExitWithErrLvl ALIAS "_exit" (BYVAL ERRORLEVEL%)

    Then to exit with an Error level contained in a variable:
        ExitWithErrorLvl Oops%

    WARNING: DO NOT USE THIS WHILE IN THE DEVELOPEMENT ENVIRONMENT IT
    WILL EXIT TO DOS WITHOUT PROMPTING FOR A SAVE.  IT HAS ON OCCASION
    LOCKED UP MY XT AND MY 386 WHEN USED IN THE ENVIRONMENT.

*>  "How do I load QB with two LIBs?"

    You can't.  You must combine the two LIBs into one and load that one
    instead.  This is a common situation that there are routines in the
    stock QB.LIB you need as well as an addon at the same time.  Here is
    how you combine two LIBs and generate a third to use.

      This combines QB.LIB and FOO.LIB into MYLIB.LIB generating a
      MYLIB.CAT catalog file:

            LIB QB.lib +FOO.LIB,MYLIB.CAT,MYLIB.CAT

    Now we must take the combined MYLIB.LIB and generate MYLIB.QLB:

            LINK /q MYLIB.LIB,MYLIB.QLB,nul,BQLB45 ;

    Note that the above lines assume that the current directory is your
    directory that contains QB45 and all the files, if not you must
    provide complete paths to all files not in the current directory.

*>  "Are there any good books on QuickBasic?"

    Yes,  probably the most recomended is:
      "MicroSoft QuickBasic Bible"
      by the Waite Group
      MicroSoft Press ISBN: 1-55615-262-0
      * Good examples on EVERY command

    Another good book that deals with INTERRUPT programming:

     "MD-DOS 5 Programming"
     by Peter G. Aitken
     MicroSoft Press ISBN: 1-55615-471-2
     * Sample code in QuickBasic and C for MANY interrupt calls

*>  "How do I get a number from a string into an Integer?"  Use:

        X% = VAL(TheString$)

*>  "How do I remove spaces from a string?"

    To remove spaces at the beginning of a string use

       X$ = LTRIM$(TheString$)

    To remove spaces at the end of a string use

       X$ = RTRIM$(TheString$)

    To remove at both beginning and end use
       X$ = LTRIM$(RTRIM$(TheString$))

*>  "What are 'String Descriptors'?"

    Generally you will never need to know this unless you plan to write
    ASM or C routines to use with QuickBasic.  String Descriptors are
    packs of 4 bytes that contain the offset within the DGROUP that the
    actual text of the string starts at and the length of the data.  QB
    does not use ASCIIZ strings (strings that end with a CHR$(0)) so you
    must convert them in your code if you wish to use them with C in
    most cases.  The block looks like:

    2 bytes     Offset within DGROUP
    2 bytes     Length of string data
    Both are UNSIGNED integers (0-65535)

*>  "What is the difference between QBASIC and QuickBasic?"
    A lot!  Some of them are:
    QBASIC will not compile a BAS file into a EXE, QB45 does.
    QBASIC does not have a CALL INTERRUPT, QB45 does.
    QBASIC does not allow use of LIBs, QB45 does.
    QBASIC is a stripped down version of QB45 included with DOS 5.0 and
    above.
    QuickBasic must be purchased.  The retail price varies but should be
    around $65-$80 U.S..

    Generally, almost all BAS code will run in QBASIC. The exception is
    that if is uses INTERRUPTS or outside LIBs, it will not.  There is
    however a CALL ABSOLUTE that does allow SOME access to ASM code but
    it is not simple and the routines must be small. Generally, if you
    are an occasional programmer, QBASIC will do just fine, however, if
    you want to end up with an EXE file or do some serious programming,
    QB45, or PDS would really be the way to go. Other packages available
    are Power Basic and Visual Basic for DOS. These other two packages
    are fine too and provide some additional commands over QB45 but as
    such are not backward compatible to QB45.

*>  "How do I convert from a HEX number to DECIMAL or DECIMAL to HEX?"

    To change from a HEX string to an integer:

      TheString$="6B"
      X%=VAL("&H"+TheString$)

    To change from an integer to a HEX string:

      X$=HEX$(TheInteger%)

*>  "How do I make QuickBasic reboot the system?"
    Here is a simple code snippit to do just this:

    SUB WarmBoot
        DEF SEG = 0
        POKE &h473, &h12
        POKE &h472, &h34
        DEF SEG = &hFFFF
        CALL ABSOLUTE(0)
    END SUB

    SUB ColdBoot
        DEF SEG = &hFFFF
        CALL ABSOLUTE(0)
    END SUB

*>  "Could anybody show me how `INKEY$' works please?"

    Inkey simply checks the keyboard and then returns.  If there was a
    keypress then it is returned, if not, inkey returns a NULL string.
    There are several methods of it's use.

    One is a one time scan....

    For x=1 to 1000
           ;do your stuff
           if inkey$=chr$(27) then exit for
    next x

    The other is to use it to scan the keyboard in a continuous loop
    until a key is pressed....

    Function GetKey$
           do:X$=Inkey$:loop while X$=""
           GetKey$=X$
    End Function

    Here is a similar routine to accept keys and Capitolize the first
    letter of each word....

    Function GetKeyCap$
    Toggle%=False
    Stuff$=""
           Do
                   X$=Inkey$
                   If X$=CHR$(13) then exit do   'User Pressed ENTER
                   If Toggle% then X$=Lcase$(X$) else X$=Ucase$(X$)
                   Stuff$=Stuff$+X$
                   Toggle%=( X$<>" ") 'Is it a Space?
           Loop

    GetKeyCap$=Stuff$

    End Function

*>  "How do you do ARCSIN and ARCCOS?"

     ARCSIN and ARCCOS are "derived" functions.  You can compute them
     using the following:

     CONST PI=3.141593
     ARCSIN(A) = ATN(A / SQR(-A * A+1))
     ARCCOS(A) = PI / 2 - ATN(A / SQR(-A * A+1))

     To convert these into full blown functions:

     Function ARCSIN# (A#)
       ARCSIN# = ATN(A# / SQR(-A# * A#+1#))
     end Function

     Function ARCCOS# (A#)
       ARCCOS# = PI / 2# - ATN(A# / SQR(-A# * A#+1#))
     end Function

*>  "How do the AND, OR, and XOR work?"

    Well, AND, OR and XOR can be mathmatical or comparative functions.

    The math functions would be (this is BIT level):

      AND           OR            XOR
    -----------   -----------   -----------
    0 AND 0 = 0   0 OR 0 = 0    0 XOR 0 = 0
    1 AND 0 = 0   1 OR 0 = 1    1 XOR 0 = 1
    0 AND 1 = 0   0 OR 1 = 1    0 XOR 1 = 1
    1 AND 1 = 1   1 OR 1 = 1    1 XOR 1 = 0

    15=1111, 7=0111, 6=0110, 2=0010, 10=1010
    so: 15 AND 7 = 7, 6 OR 2 = 6, 10 XOR 10 = 0

    The comparitive functions are like this:
    AND = "This AND That"
     OR = "This OR That"
    XOR = "This OR That BUT NOT BOTH"

    If (5 > 1) AND (6 < 10 ) then Yep
      If 5 is larger than 1 and 6 is less than 10

*>  "How do I seperate command line arguments?"

    You can use the following routine to seperate anything in a string
    variable that is seperated by spaces:

    DIM SHARED arg$(20) 'Max of 20 arguments, increase/decrease for your app.

    'Set up string and make call:

    TheString$="This is a test of the EBS system."

    NumOfWords%=ArgSplit%(TheString$)

    For x%=0 to NumOfWords%
        Print arg$(x%)
    Next x%

    SUB ArgSplit%(cline$)
           I = 1: arg = LBOUND(arg$): inword = -1
           WHILE I <= LENGTH
                   ch$ = MID$(cline$, I, 1)
                   IF ch$ <> " " THEN
                           IF NOT inword THEN inword = -1
                           arg$(arg) = arg$(arg) + ch$
                   ELSEIF inword THEN
                           arg = arg + 1
                           inword = 0
                   END IF
                   I = I + 1
           WEND
    ArgSplit% = arg
    END SUB


END of FAQ Document



Msg #:  2131                      QUIKBAS Subboard
 From:  SAUL ANSBACHER            Sent: 05-26-94 20:57
   To:  KEN WITHEROW              Rcvd: -NO-
   Re:  (R)QBNEWS AND THE BCC

 SA> Put in that code for Interrupts in QBASIC and then most people will be
 SA> able to follow along, if you don't ahve it, I can send you two
 SA> different ways.  I also have code for interrupts in GWBASIC, that is if
 SA> you want a humour coloum<g>...

 KW> Somewhere I've got the QBasic one, but not GW. Hmm... I do know how to
 KW> interface ASM language to GW (hehehe, hat's really scary).

Well try this: Weird....


100 ' MEESCALL.BAS  demonstrates how to call mouse functions in GW-BASIC
110 '
120 '   Author:     Christy Gemmell
130 '   Date:       15/9/1991
140 '
150 ' Load general-purpose interrupt service interface.
160 '
170 DEFINT A-Z: CLS: PRINT: KEY OFF
180 DIM REG.IN(7), REG.OUT(7)
190 AX = 0: BX = 1: CX = 2: DX = 3: SI = 4: DI = 5: DS = 6: ES = 7
200 SYSINT$ = SPACE$(116)
210 FOR X = 1 TO 116
220     READ A$: MID$(SYSINT$, X, 1) = CHR$(VAL("&H" + A$))
230 NEXT
240 '
250 '  Test out some mouse functions with it.
260 '
270 INT.NO = &H33   ' Microsoft Mouse driver interrupt number
280 '
290 '  Reset Mouse and get status
300 '
310 REG.IN(AX) = 0: GOSUB 770
320 IF REG.OUT(AX) = 0 THEN PRINT "Mouse not installed!": BEEP: STOP
330 PRINT "A"; REG.OUT(BX); "- button mouse is available"
340 PRINT "Turning on the Mouse pointer"
350 PRINT: PRINT "Press the <Esc> key to quit"
360 '
370 '  Show Mouse pointer
380 '
390 REG.IN(AX) = 1: GOSUB 770
400 '
410 ' Main control loop
420 '
430 IF INKEY$ = CHR$(27) THEN GOTO 600
440 '
450 '  Get Mouse pointer and button status
460 '
470    REG.IN(AX) = 3: GOSUB 770
480    LOCATE 10, 1: PRINT "X ="; REG.OUT(CX); " "
490    LOCATE 11, 1: PRINT "Y ="; REG.OUT(DX); " "
500    LOCATE 13, 1
510    IF REG.OUT(BX) = 1 THEN PRINT "Left Button Down" ELSE PRINT SPACE$(20)
520    LOCATE 14, 1
530    IF REG.OUT(BX) = 3 THEN PRINT "Centre Button Down" ELSE PRINT SPACE$(20)
540    LOCATE 15, 1
550    IF REG.OUT(BX) = 2 THEN PRINT "Right Button Down" ELSE PRINT SPACE$(20)
560 GOTO 430
570 '
580 '  Hide Mouse pointer
590 '
600 REG.IN(AX) = 2: GOSUB 770
610 END
620 '
630 '  Machine-language opcodes
640 '
650 DATA 55, 8B, EC, 8B, 5E, 0A, 8B, 07, 8B, 5E, 06, 8B, CB
660 DATA 8B, 5E, 08, 06, 1E, E8, 05, 00, 00, 00, CD, 00, C3
670 DATA 5D, 88, 46, 03, 89, 4E, 00, 8B, 4F, 04, 8B, 57, 06
680 DATA 8B, 77, 08, 8B, 7F, 0A, 8B, 47, 0E, 3D, FF, FF, 74
690 DATA 02, 8E, C0, 8B, 47, 0C, 3D, FF, FF, 74, 02, 8E, D8
700 DATA 36, 8B, 07, 36, 8B, 5F, 02, E8, CC, FF, 53, 8B, 5E
710 DATA 00, 36, 89, 07, 36, 8F, 47, 02, 8C, D8, 36, 89, 47
720 DATA 0C, 1F, 8C, C0, 89, 47, 0E, 07, 89, 4F, 04, 89, 57
730 DATA 06, 89, 77, 08, 89, 7F, 0A, 5D, CA, 06, 00, 00
740 '
750 '  Call machine-language routine
760 '
770 X = VARPTR(SYSINT$)
780 SYSINT! = PEEK(X + 1) + 256 * PEEK(X + 2)
790 CALL SYSINT!(INT.NO, REG.IN(0), REG.OUT(0))
800 RETURN

'BTW That assembly-language routine can be used for other things than
'the mouse. It is actually a general-purpose program which you can use
'to make DOS (INT 21h) and BIOS (INT 10h, INT 16h etc) interrupt calls.
'In effect a GW-BASIC version of QuickBASIC's CALL INTERRUPT.